VERSION = 3.00)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0  wsbasebuilderPixelsClass1builderbaseform wsbasebuilderwsname port wsdl wsml service wsmethod wsparmquery wssyntax wsparmnum wsparms *setup *updatemethod *updateparms  3   % qU TaR %R  B-R %CoObjectbO TmTCEC C  Builder:  C C  Object:  C  Method: TCE%%C' ... -TC Line: CCZ%C TC C  %- CxG1 X%C xTa  B-U NERRORCMETHODNLINEOOBJECT LCERRORMSG LCCODELINEMSGTHISLERRORLRELEASERELEASENAMECAPTION%C toObject2bO3B-%C XB- C%  U TOOBJECT2 TUSOURCE2 TLSKIPSEARCH2THISSETUPLRELEASESHOW] -%C CtoObjectbO %%CtoObjectbOC T%C 9R,: ' Error Mode: Object parameter requiredB-TC`% TC`%%%CCtoObjectbO 0R,:  Error Mode: Nothing selectedB-TT T C,%C this.oObjectbO C nT T -T T B-!T   % T  TC ]T  T T T T- TC` T-%%   % TC`%TCC@&%C@C @  TaT  T-%C VB-UTOOBJECTTUSOURCE TLSKIPSEARCH LNSELOBJCOUNT LCOBJECTNAMELCNAMELLCLASSLASELOBJTHISCAPTIONUSOURCEOOBJECTLCLASSCCLASS CCLASSLIBRARYRELEASENAMECLASS CLASSLIBRARY COBJECTNAME ADDOBJECTSError,Init setobjectg11QqAQARAAaAqAA4qAqAA21Q1AqA!QQqA1AAAAqAaaaA1!QQAaaAAA"qA2b!}c--R >) ATop = 0 Left = -1 Height = 275 Width = 440 Desktop = .T. DoCreate = .T. BorderStyle = 3 Caption = "XML Web Service Builder" MinHeight = 200 MinWidth = 200 Icon = ..\ wsname = port = wsdl = wsml = service = wsmethod = wsparmquery = 0 wssyntax = wsparmnum = 0 wsparms = Name = "wsbasebuilder" form..\wizards\builderd.vcx_ws3.ho-1KMS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Tahoma, 0, 8, 5, 13, 11, 21, 2, 0  wsbuilder3_ws3.hPixelsClass17 wsbasebuilder wsbuilder3)Top = 78 Left = 348 Name = "Colparms"  wsbuilder3Colparms collection_ws3client.vcxcolparmsCTop = 78 Left = 324 Height = 25 Width = 24 Name = "Wshandler"  wsbuilder3 Wshandlercustom_ws3client.vcx wshandler 4%U<TTTUTHISFORM CBOTABLES DISPLAYVALUE CBOFIELDS CBOVALUESClick,11112) wsbuilder3label1PROCEDURE Click THISFORM.cboTables.DisplayValue = "" THISFORM.cboFields.DisplayValue = "" THISFORM.cboValues.DisplayValue="" ENDPROC cmdReset commandbutton commandbutton wsbuilder31 ]PROCEDURE Error LPARAMETERS nError, cMethod, nLine, oObject #DEFINE DEBUGMODE .F. #DEFINE CR CHR(13)+CHR(10) LOCAL lcErrorMsg, lcCodeLineMsg this.lError=.T. WAIT CLEAR IF this.lRelease this.Release RETURN .F. ENDIF WAIT CLEAR IF TYPE("oObject")#"O" oObject=this ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+"Builder: "+this.Name+CR+ ; "Object: "+oObject.Name+CHR(13)+ ; "Method: "+cMethod lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,10000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF IF DEBUGMODE MESSAGEBOX(lcErrorMsg) SET STEP ON RETRY ELSE IF MESSAGEBOX(lcErrorMsg,17,this.Caption)#1 this.lRelease=.T. this.Release RETURN .F. ENDIF ENDIF ENDPROC PROCEDURE Init LPARAMETER toObject2, tuSource2, tlSkipSearch2 IF TYPE("toObject2")#"O" RETURN .F. ENDIF IF NOT DODEFAULT(toObject2, tuSource2, tlSkipSearch2) RETURN .F. ENDIF THIS.Setup() IF NOT this.lRelease this.Show ENDIF ENDPROC PROCEDURE setobject LPARAMETERS toObject,tuSource,tlSkipSearch LOCAL lnSelObjCount,lcObjectName,lcName,llClass LOCAL laSelObj[1] IF tlSkipSearch OR PARAMETERS()=1 OR TYPE("toObject")=="O" IF TYPE("toObject")=="O" OR ISNULL(toObject) laSelObj[1]=toObject ELSE IF NOT ISNULL(toObject) WAIT WINDOW this.Caption+ ; " Error Mode: Object parameter required" NOWAIT ENDIF RETURN .F. ENDIF ELSE lnSelObjCount=ASELOBJ(laSelObj) IF lnSelObjCount=0 DIMENSION laSelObj[1] lnSelObjCount=ASELOBJ(laSelObj,1) IF lnSelObjCount=0 IF ISNULL(toObject) OR TYPE("toObject")#"O" WAIT WINDOW this.Caption+ ; " Error Mode: Nothing selected" NOWAIT RETURN .F. ENDIF laSelObj[1]=toObject ENDIF ENDIF ENDIF this.uSource=tuSource this.oObject=laSelObj[1] IF TYPE("this.oObject")#"O" OR ISNULL(this.oObject) this.oObject=.NULL. this.lClass=.F. this.cClass="" this.cClassLibrary="" this.Release RETURN .F. ENDIF this.lClass=(this.oObject.Name==this.oObject.Class) IF this.lClass this.cClass=this.oObject.Name this.cClassLibrary=SYS(1271,this.oObject) ELSE this.cClass=this.oObject.Class this.cClassLibrary=this.oObject.ClassLibrary ENDIF lcObjectName=this.oObject.Name this.cObjectName=lcObjectName laSelObj=.F. DIMENSION laSelObj[1] lnSelObjCount=ASELOBJ(laSelObj) llClass=.F. IF NOT llClass AND (lnSelObjCount=0 OR lnSelObjCount=1) IF lnSelObjCount=0 DIMENSION laSelObj[1] lnSelObjCount=ASELOBJ(laSelObj,1) ENDIF IF lnSelObjCount=1 lcName=LOWER(laSelObj[1].Name) IF lcName==LOWER(lcObjectName) AND lcName==LOWER(this.oObject.Class) llClass=.T. ENDIF ENDIF ENDIF this.lClass=llClass laSelObj=.F. IF NOT this.AddObjects() RETURN .F. ENDIF ENDPROC Top = 258 Left = 80 Height = 23 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "\0 loParmForm = NEWOBJECT("wsParms", HOME()+"FFC\_ws3client.vcx") loParmForm.oColParms = THISFORM.oCallee.oOperation.colParms loParmForm.SetupWS() loParmForm.Show(1) ENDIF IF !THISFORM.wshandler.Invoke(THISFORM.oCallee.oOperation) lcErrMsg = BADTYPE1_LOC IF !EMPTY(THISFORM.wshandler.SoapErrorDetail) lcErrMsg = lcErrMsg +CRLF +CRLF + THISFORM.wshandler.SoapErrorDetail ENDIF MESSAGEBOX(lcErrMsg) RETURN ENDIF leRetVal = THISFORM.wsHandler.ReturnValue DO CASE CASE VARTYPE(leRetVal) #"O" IF VARTYPE(leRetVal) ="C" AND LOWER(LEFT(ALLTRIM(leRetVal),5))="0 THISFORM.cboValues.ListIndex=1 ENDIF THISFORM.cboTables.Enabled = lHasDataSet THISFORM.cboFields.Enabled = lHasDataSet THISFORM.cboValues.Enabled = !lHasDataSet THISFORM.Optiongroup1.Option1.Enabled=lHasDataSet THISFORM.Optiongroup1.Option2.Enabled=!lHasDataSet THISFORM.Optiongroup1.Value = IIF(lHasDataSet, 1, 2) IF THISFORM.lHasCursorAdapter AND lHasDataSet AND VARTYPE(THISFORM.wshandler.oAdapter)="O" THISFORM.cmdAttach.Enabled=.T. ENDIF THIS.Enabled=.F. ENDPROC Top = 258 Left = 16 Height = 23 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "\ Root EntryxtOleObjectDataAccessObjSiteData&\ChangedProps  Aljj(6(!C4 D !%C T,T%C ETCQULOTABLELOFIELD LCFIELDLIST LCFIELDEXPRLCTYPETHIS CBOTABLES LISTCOUNTTHISFORM WSHANDLEROADAPTERTABLESITEM LISTINDEXFIELDSDATATYPE MAXLENGTHFRACTIONDIGITSALIASOCALLEEOCONTROL CURSORSCHEMAPARENTREFRESHBU TOOBJECT2 TUSOURCE2 TLSKIPSEARCH2 setupobjects, updatefieldsT checkcadapter attachschemaInit1BAAAAAb1ABAA3qAAR1!aA!QAAAA1AA3AAA3qrAAbAA1"AAA!AAaaAB3A1Mp.<5 GW  u) labelFontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 23 Left = 108 TabIndex = 10 Top = 316 Width = 132 Name = "txtClient"  wsbuilder2 txtClient>Top = 120 Left = 12 Height = 17 Width = 20 Name = "oWeb"  lblSampleC **G%rU/%(CUKEYASCIITHISFORM CMDCANCELCLICKA C  C%CUTBT T +a)%C !"% C fCf !"T  (#C_)TTT CUNODE LCCONTROL LNCOUNTERTHISFORM UPDATEOBJECTTHIS CCONTROLPATH TXTCLIENTVALUETEXTACLIENTS LEDITMODECCONTROL CBOBINDPROP DISPLAYVALUE GETPROPNAMESKeyPress, NodeCheck1rA2r"1AAAA!AA!A1s1{-)*G ..%UT TC wsBuilder3T C CU LOCOMPLEXFORMTHISFORM CLASSLIBRARYOCALLEE SETUPOBJECTSSHOWClick,1q2).shapeShape1wsconfig optiongroup optiongroupAutoSize = .T. FontBold = .F. FontName = "Tahoma" FontSize = 8 FontUnderline = .F. BackStyle = 0 Caption = "xxxxxxxxx" Height = 15 Left = 92 Top = 8 Width = 56 Name = "lblWS" }FontName = "Tahoma" FontSize = 10 Height = 216 Left = 12 Top = 72 Width = 432 ControlSource = "" Name = "edtResults" AutoSize = .T. FontBold = .T. FontName = "Tahoma" FontSize = 8 FontUnderline = .F. BackStyle = 0 Caption = "Operation:" Height = 15 Left = 12 Top = 24 Width = 61 Name = "Label7" Label7labellabelAutoSize = .T. FontBold = .T. FontName = "Tahoma" FontSize = 8 FontUnderline = .F. BackStyle = 0 Caption = "Web Service:" Height = 15 Left = 12 Top = 8 Width = 75 Name = "Label6" wstestLabel6labellabelwstestlblWSDLlabel_hyperlink.vcx_hyperlinklabel+OLEObject = C:\WINNT\System32\shdocvw.dll wstest oleBrowser olecontrol4EFontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "Go to Microsoft UDDI Web Site" Height = 15 Left = 240 MouseIcon = graphics\h_point.cur Top = 204 Width = 149 TabIndex = 10 ForeColor = 0,0,255 ctarget = http://uddi.microsoft.com/search/frames.aspx nvisitedforecolor = 16711680 Name = "_hyperlinklabel1" label_hyperlink.vcxFontName = "Tahoma" FontSize = 8 MaxLength = 254 ControlSource = "" Height = 22 Left = 107 Style = 2 TabIndex = 6 Top = 87 Width = 312 Name = "cboWSDLFile" FontBold = .T. FontName = "Tahoma" FontSize = 8 FontUnderline = .F. BackStyle = 0 Caption = "View WSDL" Height = 15 Left = 84 MouseIcon = graphics\h_point.cur Top = 294 Width = 63 ForeColor = 0,0,255 nvisitedforecolor = 16711680 lnewwindow = .T. Name = "lblWSDL" GPROCEDURE Refresh *** ActiveX Control Method *** NODEFAULT ENDPROC  olecontrolformtextboxtextboxwsreg PROCEDURE Click LOCAL loXML, i, lcAlias * Close any open tables IF !EMPTY(ALIAS()) USE ENDIF IF THISFORM.oleBrowser.Visible = .F. THISFORM.oleBrowser.Visible = .T. THISFORM.Grid1.Visible = .F. THISFORM.lblBrowse.Caption = DATAVIEW_LOC RETURN ELSE THISFORM.oleBrowser.Visible = .F. THISFORM.Grid1.Visible = .T. THISFORM.lblBrowse.Caption = XMLVIEW_LOC ENDIF TRY SET SAFETY OFF IF THISFORM.ldataset THISFORM.oAdapter = CREATEOBJECT("xmladapter") loXML=THISFORM.ReturnValue THISFORM.oAdapter.MapN19_4ToCurrency = .T. THISFORM.oAdapter.Attach(loXml.Item(1), loXml.Item(0)) THISFORM.cboCursors.Clear() FOR i = 1 TO THISFORM.oAdapter.Tables.Count lcAlias = THISFORM.oAdapter.Tables.Item(m.i).Alias IF USED(lcAlias) USE IN (lcAlias) ENDIF THISFORM.cboCursors.AddItem(lcAlias) ENDFOR THISFORM.lblResults.Caption=DOTNET_LOC THISFORM.cboCursors.ListIndex=1 THISFORM.cboCursors.Visible=.T. THISFORM.cboCursors.InteractiveChange() ELSE XMLTOCURSOR(THISFORM.ReturnValue) THISFORM.Grid1.RecordSource=ALIAS() ENDIF THISFORM.Grid1.AutoFit() CATCH MESSAGEBOX(NOCURSOR_LOC) THISFORM.oleBrowser.Visible = .T. THISFORM.Grid1.Visible = .F. THISFORM.lblBrowse.Caption = DATAVIEW_LOC ENDTRY ENDPROC 16 PROCEDURE setupobjects THIS.Checkcadapter() WITH THIS.oCallee THIS.wshandler.Wsdl = .Wsdl THIS.wshandler.Wsml = .Wsml THIS.wsmethod = .wsMethod THIS.wsSyntax = .wsSyntax THIS.cboTables.DisplayValue = .DSTable THIS.cboFields.DisplayValue = .DSField THIS.chkExisting.Value = .DSUseExistingCursor THIS.cboValues.DisplayValue = .NodeName IF EMPTY(.DSTable) AND !EMPTY(.NodeName) AND !THIS.lHasCursorAdapter THIS.Optiongroup1.Value=2 ENDIF ENDWITH IF THIS.lHasCursorAdapter THIS.chkExisting.Enabled=.F. THIS.Optiongroup1.Option2.Enabled=.F. ENDIF ENDPROC PROCEDURE updatefields LOCAL loTable, loField, lcOldField, i, lFound IF THIS.cbotables.ListCount = 0 OR VARTYPE(THISFORM.wshandler.oAdapter)#"O" RETURN ENDIF lcOldField=ALLTRIM(THISFORM.cboFields.DisplayValue) TRY THIS.cboFields.Clear() loTable = THISFORM.wshandler.oAdapter.Tables.Item(THIS.cbotables.ListIndex) FOR EACH loField IN loTable.Fields THIS.cboFields.AddItem(loField.Alias) ENDFOR * Special handling first time to save original field IF THIS.cmdquery.Enabled AND !EMPTY(lcOldField) FOR i = 1 TO THIS.cboFields.ListCount IF UPPER(THIS.cboFields.List(m.i))==UPPER(lcOldField) THIS.cboFields.ListIndex=m.i lFound=.T. EXIT ENDIF ENDFOR ENDIF IF THIS.cboFields.ListCount>0 AND !lFound THIS.cboFields.ListIndex=1 ENDIF CATCH ENDTRY ENDPROC PROCEDURE checkcadapter IF TYPE("THIS.oCallee.oControl")#"O" RETURN ENDIF IF ATC("CursorAdapter", THIS.oCallee.oControl.BaseClass)#0 AND; ALLTRIM(UPPER(THIS.oCallee.cboBindProp.DisplayValue))=="CURSORFILL" THIS.lHasCursorAdapter=.T. ENDIF ENDPROC PROCEDURE attachschema LOCAL loTable, loField, lcFieldList, lcFieldExpr, lcType IF THIS.cbotables.ListCount = 0 RETURN ENDIF IF MESSAGEBOX(CONFIRM_ATTACHSCHEMA_LOC,36)#6 RETURN ENDIF TRY lcFieldList="" loTable = THISFORM.wshandler.oAdapter.Tables.Item(THIS.cbotables.ListIndex) FOR EACH loField IN loTable.Fields lcType = loField.DataType DO CASE CASE ATC("C", loField.DataType)#0 lcType= lcType +"(" + TRANSFORM(loField.MaxLength) +")" CASE ATC("N", loField.DataType)#0 lcType= lcType +"(" + TRANSFORM(loField.MaxLength) +","+TRANSFORM(loField.FractionDigits)+")" ENDCASE lcFieldExpr = loField.Alias + " " + lcType * Limited to 255 chars for Property in Property Sheet IF LEN(lcFieldList + "," + lcFieldExpr)>255 EXIT ENDIF IF !EMPTY(lcFieldList) lcFieldList = lcFieldList + "," ENDIF lcFieldList = lcFieldList + lcFieldExpr ENDFOR IF !EMPTY(lcFieldList) THIS.oCallee.oControl.CursorSchema = lcFieldList THIS.oCallee.oControl.Parent.Refresh() ENDIF CATCH ENDTRY ENDPROC PROCEDURE Init LPARAMETER toObject2, tuSource2, tlSkipSearch2 RETURN ENDPROC FontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 24 Left = 300 Style = 2 TabIndex = 8 Top = 284 Width = 204 ZOrderSet = 19 BorderColor = 0,128,192 ItemTips = .T. Name = "cboBind" FontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 24 Left = 300 Style = 2 TabIndex = 6 Top = 252 Width = 204 ZOrderSet = 19 BorderColor = 0,128,192 ItemTips = .T. Name = "cboPEMS" AutoSize = .T. FontBold = .F. FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "Client \ Root EntryᄜOleObjectDataAccessObjSiteData&\ChangedProps& Aljj(6(!C4S %3#U CInput values now0C Programmatically set at run-time"CPrompt at run-timeTUTHISADDITEM LISTINDEX CUTHISFORM UPDATEPARMSInit,InteractiveChange1!32)wsconfiglabellabelcmdOK8PROCEDURE KeyPress *** ActiveX Control Event *** LPARAMETERS keyascii IF keyascii=27 THISFORM.cmdCancel.Click() ENDIF ENDPROC PROCEDURE NodeCheck *** ActiveX Control Event *** LPARAMETERS node DODEFAULT(node) LOCAL lcControl, lnCounter THISFORM.UpdateObject() IF EMPTY(THIS.cControlPath) THISFORM.txtClient.Value = "" RETURN ENDIF * Get new Client Name lcControl = node.Text lnCounter = 2 DO WHILE .T. IF ASCAN(THISFORM.aClients, lcControl,-1,-1,-1,7)=0 EXIT ENDIF IF THISFORM.lEditmode AND UPPER(THISFORM.cControl)==UPPER(lcControl) EXIT ENDIF lcControl= node.Text + " (#" + TRANSFORM(lnCounter) + ")" lnCounter = lnCounter + 1 ENDDO THISFORM.txtClient.Value = lcControl * Get unique Property name THISFORM.cboBindProp.DisplayValue =THISFORM.GetPropNames() ENDPROC gTop = 120 Left = 12 Height = 123 Width = 492 TabIndex = 4 lincludede = .T. Name = "Olecontrols"  Olecontrols olecontrol _ws3utils.vcx olecontrols AutoSize = .T. FontBold = .F. FontName = "Tahoma" FontSize = 8 WordWrap = .T. BackStyle = 0 Caption = "\ Root Entryx@OleObjectDataAccessObjSiteData&8ChangedProps1aV 4kOL,SL885.0 MenuBarL AddressBarL-8747-5Ws5i+.bLFt TreeView Control, version 5.0 (SP2) {0713E8A2-850A-101B-AFC0-4210102A8DA7} C:\WINDOWS\System32\comctl32._ws3.hTop = 372 Left = 444 Height = 23 Width = 60 FontName = "Tahoma" FontSize = 8 Cancel = .T. Caption = "Cancel" TabIndex = 17 ZOrderSet = 3 Name = "cmdCancel"  @%{U#T CUTHISFORMOCALLEE OOPERATIONRELEASEClick,111C)RTop = 12 Left = 66 Height = 2 Width = 457 SpecialEffect = 0 Name = "Shape1" PROCEDURE Click LOCAL loComplexForm loComplexForm = NEWOBJECT("wsBuilder3", THISFORM.ClassLibrary) loComplexForm.oCallee = THISFORM loComplexForm.SetupObjects() loComplexForm.SHOW() ENDPROC PixelsAutoSize = .T. Top = 372 Left = 203 Height = 23 Width = 101 FontName = "Tahoma" FontSize = 8 Caption = "Comple\0 THIS.olecontrols.Nodes.Item(1).Expanded=.T. ENDIF * Update List of parms FOR EACH loParm IN THIS.oCallee.colParms THIS.colParms.Add(loparm) THIS.lstParms.AddItem(loParm.ParmName) ENDFOR THIS.lstParms.ListIndex=1 THIS.lblsyntax.Caption=THIS.oCallee.WsSyntax THIS.UpdateParm() ENDPROC PROCEDURE updateobject LOCAL loObject, lcObject, laPEMs, i, lnPEMs, loParm DIMENSION laPEMs[1] * This routine essentially updates the cboPEMs dropdown with * properties of the selected object. THIS.cControlpath = THIS.olecontrols.cControlPath lcObjPath = THIS.olecontrols.cControlPath THIS.cboPEMS.Clear() IF EMPTY(THIS.olecontrols.cControlPath) THIS.cboPEMS.Enabled = .F. RETURN ELSE THIS.cboPEMS.Enabled = .T. ENDIF loObject = THIS.olecontrols.oContainer IF ATC(".", lcObjPath)#0 && we have outer container lcObject = SUBSTRC(lcObjPath, ATC(".", lcObjPath)+1) && trim off outer name of parent loObject = loObject.&lcObject. ENDIF * Update the Bind Target combo lnPEMs = AMEMBERS(laPEMs, loObject, 0) THIS.cboPEMS.AddItem(WSNONE_LOC) FOR i = 1 TO lnPEMs IF !PEMSTATUS(loObject, laPEMs[m.i],1) THIS.cboPEMS.AddItem(PROPER(laPEMs[m.i])) ENDIF ENDFOR * Set default values loParm = THIS.colParms.Item(THIS.lstParms.ListIndex) IF !EMPTY(loParm.InputProperty) THIS.cboPEMS.Value = loParm.InputProperty ELSE DO CASE CASE ASCAN(laPEMs,"VALUE")#0 THIS.cboPEMS.Value = "Value" CASE ASCAN(laPEMs,"CAPTION")#0 THIS.cboPEMS.Value = "Caption" CASE ASCAN(laPEMs,"RECORDSOURCE")#0 THIS.cboPEMS.Value = "Recordsource" OTHERWISE THIS.cboPEMS.ListIndex = 1 ENDCASE ENDIF ENDPROC PROCEDURE updateparm LOCAL lnIndex, loParm, loNode lnIndex = THIS.lstParms.ListIndex loParm = THIS.colParms.Item(lnIndex) THIS.lblParmType.Caption = loParm.ParmType THIS.nlastindex=lnIndex THIS.Optiongroup1.Value=0 * Value parameter IF EMPTY(loParm.InputControl) THIS.txtValue.Value=loParm.InputValue THIS.oleControls.cControlpath = "" IF !EMPTY(THIS.oleControls.cCheckedKey) THIS.oleControls.Nodes(THIS.oleControls.cCheckedKey).Checked=.F. ENDIF THIS.oleControls.cCheckedkey="" THIS.Optiongroup1.Value=1 RETURN ENDIF * Need to locate this path THIS.oleControls.cControlpath = loParm.InputControl THIS.txtValue.Value="" FOR EACH loNode IN THIS.olecontrols.Nodes IF UPPER(loNode.FullPath)==UPPER(THIS.oleControls.cControlpath) loParm.InputValue="" loNode.Selected = .T. loNode.EnsureVisible() IF !loNode.Checked loNode.Checked=.T. THIS.oleControls.NodeCheck(loNode) ENDIF EXIT ENDIF ENDFOR THIS.optiongroup1.Value=2 ENDPROC PROCEDURE saveparm LOCAL lnIndex, loParm lnIndex = THIS.nlastindex loParm = THIS.colParms.Item(lnIndex) IF THIS.Optiongroup1.Value=1 loParm.InputValue=ALLTRIM(THIS.txtValue.Value) loParm.InputControl = "" loParm.InputProperty = "" ELSE loParm.InputValue="" loParm.InputControl = THIS.cControlPath loParm.InputProperty = THIS.cboPEMS.DisplayValue ENDIF ENDPROC PROCEDURE Init LPARAMETER toObject2, tuSource2, tlSkipSearch2 RETURN ENDPROC editbox wsbuilder1 chkOfflinecheckboxcheckbox wsbuilder1ClassTop = 372 Left = 24 Height = 15 Width = 226 FontName = "Tahoma" FontSize = 8 AutoSize = .T. BackStyle = 0 Caption = "Allow \ Root EntryDŽOleObjectDataAccessObjSiteData&\ChangedProps& Aljj(6(!C42 ,?T ;@T AAT BBT CCT DDT ET -T FBT -T !T :;BindMe C 7UGLAPARENTLAOBJSILNOBJSLFOUNDLCOBJREFLONODE LNCLIENTSLNITEM LOOPERATIONLOPARMLOOBJLOCLIENTTHIS OLECONTROLSNODESCOUNTOCALLEE OOPERATION COLCLIENTSACLIENTSITEM CLIENTNAME COLOPERATIONS ACLIENTPROPS OBJECTREFBINDPROPWSDLWSML LEDITMODENACTIONCBOBINDADDITEM LISTINDEX PFSETTINGS PGMETHODS LSTOPERATIONSLISTCOLPARMSPARMNAMEWSMETHODEXPANDEDOCLIENT TXTCLIENTVALUE CCONTROLPATHFULLPATHCHECKEDSELECTED ENSUREVISIBLE ISINDATAENV CCONTROLNAMETEXT CCHECKEDKEYKEY UPDATEOBJECTCBOPEMS BINDTARGET CBOBINDPROP DISPLAYVALUE CHKSTARTUPLINVOKEATSTARTCHKALWAYSCALLWEBSERVICELALWAYSCALLWEBSERVICE BINDSOURCEDSTABLEDSFIELDDSUSEEXISTINGCURSORNODENAMECCONTROL CCONTROLPROP $% ; B%CC fBTBindMe T +a8%C ,!TTBindMeC_ BU LCNAMELNCOUNTTHIS LEDITMODE OLECONTROLS CCONTROLPATH CCONTROLPROP CBOBINDPROP DISPLAYVALUE ACLIENTPROPSBU TOOBJECT2 TUSOURCE2 TLSKIPSEARCH2TUTHISOCONTROL updateobject, setupobjects getpropnames~InitDestroyE1QAA221A1Ar!AA1A1qAAqAA2A1A21qqAqAAS!q!A1AAba1QaAbA21AAQAaaAAAAAAAAAAAAA13BAA2AAA2A21DpXm)PROCEDURE updateobject LOCAL laParent, lcObject, loObject, laPEMs, i, lnPEMs, lcObjPath, loErr, lHadError, lcErrMsg * This routine essentially updates the cboPEMs dropdown with * properties of the selected object. DIMENSION laParent[1] DIMENSION laPEMs[1] THIS.cboPEMS.Clear() IF EMPTY(THIS.olecontrols.cControlPath) * User unchecked item THIS.cboPEMS.Enabled = .F. RETURN ELSE THIS.cboPEMS.Enabled = .T. ENDIF lcObjPath = THIS.olecontrols.cControlPath IF THIS.oleControls.lDataenv IF VARTYPE(THIS.oleControls.oDataenv)="O" loObject = THIS.oleControls.oDataenv ELSE ASELOBJ(laParent,2) loObject = laParent[1] ENDIF ELSE loObject = THIS.oleControls.oContainer ENDIF IF ATC(".", lcObjPath)#0 && we do not have outer container lcObject = SUBSTRC(lcObjPath, ATC(".", lcObjPath)+1) * Check if object exists TRY loObject = loObject.&lcObject. CATCH TO loErr lHadError=.T. lcErrMsg=loErr.Message ENDTRY ENDIF IF lHadError THIS.olecontrols.cControlPath="" THIS.cboPEMS.Enabled = .F. RETURN !lHadError ENDIF * Update the Bind Property combo THIS.cboBindProp.Clear() THIS.cboBindProp.DisplayValue = "" lnPEMs = AMEMBERS(laPEMs, loObject, 1, "U") FOR i = 1 TO lnPEMs IF !PEMSTATUS(loObject, laPEMs[m.i, 1], 1) AND ATC("OBJECT", laPEMs[m.i, 2])=0 THIS.cboBindProp.AddItem(PROPER(laPEMs[m.i, 1])) ENDIF ENDFOR * Update the Bind Target combo lnPEMs = AMEMBERS(laPEMs, loObject,0) THIS.cboPEMS.AddItem(WSNONE_LOC) FOR i = 1 TO lnPEMs IF !PEMSTATUS(loObject, laPEMs[m.i],1) THIS.cboPEMS.AddItem(PROPER(laPEMs[m.i])) ENDIF ENDFOR * Set default values DO CASE CASE PEMSTATUS(loObject, "CursorFill", 5) * Special case for CursorAdapter * THIS.cboPEMS.ListIndex=1 THIS.cboPEMS.Enabled = .F. THIS.cboBindProp.AddItem("CursorFill") THIS.cboBindProp.DisplayValue = "CursorFill" CASE ASCAN(laPEMs,"RECORDSOURCE")#0 THIS.cboPEMS.DisplayValue = "Recordsource" CASE ASCAN(laPEMs,"VALUE")#0 THIS.cboPEMS.DisplayValue = "Value" CASE ASCAN(laPEMs,"CAPTION")#0 THIS.cboPEMS.DisplayValue = "Caption" OTHERWISE THIS.cboPEMS.ListIndex = 1 ENDCASE THIS.oControl = loObject ENDPROC PROCEDURE setupobjects LOCAL laParent, laObjs, i, lnObjs, lFound, lcObjRef, loNode, lnClients LOCAL lnItem, loOperation, loParm, loObj, loClient DIMENSION laObjs[1] DIMENSION laParent[1] * Check for valid objects on form to bind to IF THIS.olecontrols.Nodes.Count=0 MESSAGEBOX(NOOBJECTS_LOC) RETURN .F. ENDIF * Get list of current clients lnClients=THIS.oCallee.oOperation.colClients.Count IF lnClients>0 DIMENSION THIS.aClients[lnClients] FOR i = 1 TO lnClients THIS.aClients[m.i] = THIS.oCallee.oOperation.colClients.Item(m.i).Clientname ENDFOR ENDIF * Get list of current binding properties FOR EACH loOperation IN THIS.oCallee.colOperations FOR EACH loClient IN loOperation.colClients IF !EMPTY(THIS.aClientProps[1]) DIMENSION THIS.aClientProps[ALEN(THIS.aClientProps,1)+1, 1] ENDIF THIS.aClientProps[ALEN(THIS.aClientProps,1), 1] = loClient.ObjectRef + "," + loClient.BindProp ENDFOR ENDFOR THIS.WSDL = THIS.oCallee.WSDL THIS.WSML = THIS.oCallee.WSML THIS.lEditmode = (THIS.ocallee.nAction = 2) * Update the Bind Source combo with ReturnValue and operation parameters THIS.cboBind.AddItem("ReturnValue") THIS.cboBind.ListIndex=1 lnItem = THIS.ocallee.pfSettings.pgMethods.lstOperations.ListIndex THIS.oOperation = THIS.ocallee.colOperations(THIS.ocallee.pfSettings.pgMethods.lstOperations.List(lnItem,2)) FOR EACH loParm IN THIS.oOperation.colParms THIS.cboBind.AddItem(loParm.Parmname) ENDFOR THIS.wsMethod = THIS.oOperation.wsMethod * Ensure first node always expanded IF THIS.olecontrols.Nodes.Count>0 THIS.olecontrols.Nodes.Item(1).Expanded=.T. ENDIF THIS.ocallee.nAction = 0 * User clicked Edit button IF THIS.lEditMode WITH THIS.oCallee.oClient THIS.txtClient.Value=.Clientname THIS.olecontrols.cControlpath= .ObjectRef * Need to locate this path lcObjRef = .ObjectRef FOR EACH loNode IN THIS.olecontrols.Nodes IF UPPER(loNode.FullPath)==UPPER(lcObjRef) loNode.Checked = .T. loNode.Selected = .T. loNode.EnsureVisible() THIS.oleControls.IsInDataEnv(loNode) THIS.olecontrols.cControlname = loNode.Text THIS.olecontrols.cCheckedkey = loNode.Key lFound=.T. EXIT ENDIF ENDFOR IF !lFound MESSAGEBOX(MISSINGCLIENT_LOC+CRLF+CRLF+lcObjRef) ELSE IF THIS.UpdateObject() THIS.cboPEMS.Value = .BindTarget THIS.cboBindProp.DisplayValue = .BindProp THIS.chkStartup.Value = .lInvokeAtStart THIS.chkAlwaysCallWebService.Value = .lAlwaysCallWebService THIS.cboBind.DisplayValue = .BindSource THIS.DStable = .DSTable THIS.DSField = .DSField THIS.DSUseExistingCursor = .DSUseExistingCursor THIS.Nodename = .Nodename * Save original settings to validate later THIS.cControl=.Clientname THIS.cControlPath=.ObjectRef THIS.cControlProp=.BindProp RETURN ENDIF ENDIF ENDWITH ENDIF THIS.lEditMode=.F. THIS.cboBind.ListIndex=1 THIS.cboBindProp.DisplayValue = DEF_BINDPROP THIS.UpdateObject() ENDPROC PROCEDURE getpropnames LOCAL lcName, lnCount IF THIS.lEditmode AND THIS.olecontrols.cControlPath==THIS.cControlPath RETURN THIS.cControlProp ENDIF IF !EMPTY(ALLTRIM(THIS.cboBindProp.DisplayValue)) RETURN THIS.cboBindProp.DisplayValue ENDIF lcName=DEF_BINDPROP lnCount=1 DO WHILE .T. IF ASCAN(THIS.aClientprops, THIS.olecontrols.cControlPath+ "," + lcName, -1, -1, -1, 7)=0 EXIT ENDIF lnCount=lnCount+1 lcName = DEF_BINDPROP+TRANSFORM(lnCount) ENDDO RETURN lcName ENDPROC PROCEDURE Init LPARAMETER toObject2, tuSource2, tlSkipSearch2 RETURN ENDPROC PROCEDURE Destroy THIS.oControl = "" ENDPROC AutoSize = .T. FontBold = .F. FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "Set \0 AND !UPPER(THISFORM.oOperation.wsMethod)==UPPER(lcOldMethod) AND MESSAGEBOX(REMOVECLIENTS_LOC,36)=6 THISFORM.oOperation.colClients.Remove(-1) THIS.Parent.lstClients.Clear() THIS.Parent.Activate() ENDIF THISFORM.oOperation = "" ENDPROC Top = 94 Left = 322 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "\ 0 THIS.Parent.lstOperations.ListIndex=1 THISFORM.Updateclients() ENDIF THIS.Parent.Activate() ENDPROC  yy\%0U.T%% NB=%C&Do you want to delete selected client?$xBTCC T %TCC  C CULNITEMLCID LOOPERATIONTHISPARENT LSTCLIENTS LISTINDEX LISTCOUNTLIST REMOVEITEM LSTOPERATIONSTHISFORM COLOPERATIONS COLCLIENTSREMOVEACTIVATEClick,1aQAAAAqbQA1)yTop = 298 Left = 322 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "Re\%*CURI* CUTHISFORM LDEFAULTMODEOWEB UPDATEPREFSRELEASEClick,1A2)Top = 208 Left = 380 Height = 23 Width = 72 FontName = "Tahoma" FontSize = 8 Caption = "\= T %C 6TSyntax: C C C C %C ;T Description: C C C C !%C C=, JMTYour Parameters: ()C C C C *TC C C C TU LCPARMEXPRLOITEM LCDESCPANELCDESCTHISCBOPARMSENABLED WSPARMNUMCMDPARMS LISTINDEXCOLPARMSCOUNT INPUTCONTROL INPUTPROPERTY INPUTVALUE CBOMETHODS LISTCOUNTWSSYNTAXWSDOCUMENTATIONWSMETHODWSDLEDTDESCVALUEBU TOOBJECT2 TUSOURCE2 TLSKIPSEARCH2setupws, updatemethod updateparmspInit 111AqA!AAAcqAAb1aaaAAAAAA2B3q22BQ!AAA"AAAAA!AB21aQ1AAAaAAA2B2A1t, 8T iqQ)  %W#U.% ABTTC T C TTC T C F T  TC wsBuilder2 T %C I<^ CF%C O+CC fCC f -T C T T U LODETFORMLNITEMLCIDTHISPARENT LSTCLIENTS LISTINDEX LISTCOUNT LSTOPERATIONSLISTTHISFORM OOPERATION COLOPERATIONSOCLIENT COLCLIENTSOWEBCWSALIASNACTION CLASSLIBRARYOCALLEE SETUPOBJECTSSHOW CLIENTNAMEClick,1AAbb!qAdA1)PROCEDURE Click THIS.Enabled = .F. IF !THISFORM.oWeb.AddFoxCode(THISFORM.wsdl, .T.) MESSAGEBOX(MB_ERRNOWSDL_LOC) RETURN .F. ENDIF SELECT (THISFORM.oWeb.cWSAlias) LOCATE FOR UPPER(ALLTRIM(URI)) == UPPER(ALLTRIM(THISFORM.wsdl)) AND ; UPPER(ALLTRIM(Name)) == UPPER(ALLTRIM(THISFORM.Service)) AND ; UPPER(ALLTRIM(Port)) == UPPER(ALLTRIM(THISFORM.Port)) AND ; UPPER(Type)="C" AND !DELETE() IF !FOUND() MESSAGEBOX(MB_ERRNOWSDL_LOC) RETURN ENDIF THISFORM.UpdateService(ALLTRIM(UniqueID)) ENDPROC FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "Refresh" Height = 15 Left = 167 MousePointer = 15 Top = 41 Width = 40 TabIndex = 13 ForeColor = 0,0,255 ZOrderSet = 3 nvisitedforecolor = 16711680 Name = "lblRefresh" wsbuilder.pfSettings.pgServices_hyperlinklabelwsbuilder.pfSettings.pgServiceslblNewWSlabel_hyperlink.vcx_hyperlinklabelwsbuilder.pfSettings.pgServicesFontName = "Tahoma" FontSize = 8 Caption = "Publish XML Web Service" Height = 15 Left = 12 Top = 5 Width = 120 TabIndex = 1 Name = "Label3" Label1label % UTTTT(%  T (%  T U THISCMDEDITENABLED LSTOPERATIONS LISTCOUNTCMDEDIT2 LSTCLIENTSCMDDELCMDDEL2 LISTINDEXpgMethods.Activate,11A1A2) @%qUCUTHISFORM PROCESSFILETHIS DISPLAYVALUEInteractiveChange,112F)lblNewwsconfiglabelPROCEDURE Click LOCAL lcStr, i lcStr = ALLTRIM(THISFORM.txtUDDI.Value) IF EMPTY(lcStr) RETURN ENDIF THISFORM.cboWS.Clear() THISFORM.edtDetails.Value = "" DIMENSION THISFORM.aUDDI[1,5] STORE "" TO THISFORM.aUDDI WAIT WINDOW SEARCHUDDI_LOC NOWAIT THISFORM.SearchBusiness(lcStr) THISFORM.SearchService(lcStr) WAIT CLEAR IF EMPTY(THISFORM.aUDDI[1,5]) THISFORM.cboWS.Enabled = .F. THISFORM.cmdSelect.Enabled = .F. MESSAGEBOX(NOUDDIMATCH_LOC) RETURN ENDIF FOR i = 1 TO ALEN(THISFORM.aUDDI,1) THISFORM.cboWS.AddItem(THISFORM.aUDDI[m.i,3]) ENDFOR THISFORM.cmdSelect.Enabled = .T. THISFORM.cboWS.Enabled = .T. THISFORM.cboWS.Listindex = 1 THISFORM.cboWS.InteractiveChange() ENDPROC o VV% Un(%CO C ZTT CU THISFORMOREFCBOWS DISPLAYVALUECNEWWSCNEWWSDLLBLWSDLCTARGETRELEASEClick,1A1)VPROCEDURE Click IF VARTYPE(THISFORM.oref) = "O" AND !EMPTY(THISFORM.cboWS.DisplayValue) THISFORM.oRef.cNewWS = THISFORM.cboWS.DisplayValue THISFORM.oRef.cNewWSDL = THISFORM.lblWSDL.cTarget ENDIF THISFORM.Release() ENDPROC  commandbuttonTop = 87 Left = 423 Height = 22 Width = 24 FontName = "Tahoma" FontSize = 8 Caption = "..." Enabled = .T. TabIndex = 7 Name = "cmdWSDLLoc" .PROCEDURE Click THISFORM.Refresh() ENDPROC Top = 240 Left = 276 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "Se\%B(TC6TT%T \ 0 AND ; MESSAGEBOX(OPENOPS_LOC, 36)=7 RETURN ENDIF THIS.Caption = ADDNEWWS_LOC THISFORM.colOperations.Remove(-1) THISFORM.pfSettings.pgMethods.lstOperations .Clear() THISFORM.colClients.Remove(-1) THISFORM.pfSettings.pgMethods.lstClients.Clear() THISFORM.pfSettings.PgServices.lblRefresh.Visible = .F. THISFORM.lwsFound = .T. * Reset core properties WITH THISFORM .WSDL = "" .WSML = "" .Service = "" .Port = "" .wsname = "" .wsmethod = "" .lFirsttime = .T. ENDWITH ELSE DO (_wizard) WITH "","webservice",,"INTELLISENSE" ENDIF THISFORM.UpdateAll() ENDPROC FontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 108 Left = 10 TabIndex = 3 Top = 56 Width = 384 ZOrderSet = 2 IntegralHeight = .T. ItemTips = .T. Name = "lstServices" form$   r%UVTCCC DLL;TLB;EXE@%C C0 OCULCFILETHISFORM PROCESSFILEClick,1qA2) wstool.pf1.pgOptionsTop = 208 Left = 456 Height = 23 Width = 72 FontName = "Tahoma" FontSize = 8 Cancel = .T. Caption = "Cancel" TabIndex = 13 Name = "cmdCancel"  _ws3utils.vcx>Top = 204 Left = 12 Height = 24 Width = 24 Name = "oWeb"  txtActionURIoTop = 216 Left = 11 Height = 168 Width = 384 BackStyle = 0 SpecialEffect = 0 Style = 3 Name = "Shape1"  %Q 9U TC%C@ FmFCC#)T U LCALIASTHISFORMOADAPTERTABLESITEMTHIS LISTINDEXALIASTOCURSORGRID1 RECORDSOURCEInteractiveChange,1qAR12)RTop = 12 Left = 60 Height = 2 Width = 372 SpecialEffect = 0 Name = "Shape1" textboxPROCEDURE pgMethods.Activate THIS.cmdEdit.Enabled = THIS.lstOperations.ListCount>0 THIS.cmdEdit2.Enabled = THIS.lstClients.ListCount>0 THIS.cmdDel.Enabled = THIS.lstOperations.ListCount>0 THIS.cmdDel2.Enabled = THIS.lstClients.ListCount>0 IF THIS.lstOperations.ListIndex = 0 AND THIS.lstOperations.ListCount>0 THIS.lstOperations.ListIndex = 1 ENDIF IF THIS.lstClients.ListIndex = 0 AND THIS.lstClients.ListCount>0 THIS.lstClients.ListIndex = 1 ENDIF ENDPROC  pfSettings pageframe pageframe c % : $U%"B"TCC-C' %C4y> U LCIDTHISFORM LSTSERVICES LISTCOUNTLIST LISTINDEXUNIQUEIDTOOLBOXTHISVALUEInteractiveChange,1qqAA!QA2 )wstool.pf1.pgURIswspubGPROCEDURE Click THISFORM.UpdateObject() THISFORM.Release() ENDPROC Top = 436 Left = 296 Height = 22 Width = 60 FontName = "Tahoma" FontSize = 8 Caption = "OK" Default = .T. TabIndex = 2 ZOrderSet = 2 Name = "cmdOK"  wsbuildercmdOKcmdAdvTop = 124 Left = 12 Height = 23 Width = 72 FontName = "Tahoma" FontSize = 8 Caption = "\X CULCIDTHISFORM LSTSERVICESLIST LISTINDEXUNIQUEIDTYPE UPDATELISTClick,1qaAA!QAA2)6 Q%U CUTHISFORM CHECKCLASS CUTHISINTERACTIVECHANGEInteractiveChange,ProgrammaticChangeV1324]w) lblMessageURIwstool.pf1.pgURIs txtMessageURItextboxwstool.pf1.pgURIsShape1FontName = "Tahoma" FontSize = 8 ControlSource = "" Enabled = .T. Height = 22 Left = 107 TabIndex = 19 Top = 195 Width = 156 Name = "txtAppName"  commandbutton commandbutton &%U7%C B C CUTHISFORM CHECKPATHS UPDATESETSRELEASEClick,1!AA2i)checkboxErasePage = .T. PageCount = 2 TabStyle = 1 Top = 12 Left = 12 Width = 410 Height = 420 TabIndex = 1 ZOrderSet = 5 Name = "pfSettings" Page1.FontName = "Tahoma" Page1.FontSize = 8 Page1.Caption = "\<1. Services" Page1.HelpContextID = 1231129 Page1.Name = "pgServices" Page2.FontName = "Tahoma" Page2.FontSize = 8 Page2.Caption = "\<2. Operations" Page2.HelpContextID = 1231130 Page2.Name = "pgMethods"  wsbuilderFontName = "Tahoma" FontSize = 8 Value = http://tempuri.org/Proj1/message/ ControlSource = "" Height = 22 InputMask = (REPLICATE("X",254)) Left = 35 TabIndex = 7 Top = 185 Width = 408 Name = "txtMessageURI" imageimageshape>Top = 379 Left = 16 Height = 16 Width = 17 Name = "oWeb" custom _ws3utils.vcx _webservicesWlfirsttime Reserved. ooperation Reserved. naction Reserved. lwsfound Reserved. csavenotify Reserved. oclient Reserved. operationclass Reserved. operationclasslib Reserved. *updateall Reserved. *updateservice Reserved. *loadobject Reserved. *updateobject Reserved. *updateclients Reserved. *displayerror Reserved. *getcontainer  _ws3utils.vcx_ws3.ho-wsconfig_ws3.hPixelsClass$   v%iU3 % ,CUNKEYCODE NSHIFTALTCTRLTHISFORMCMDOKCLICKn%B"TCCTT U LCURITHIS LISTCOUNTTHISFORM LSTSERVICESLIST LISTINDEXLBLWSDLCTARGETLBLURICAPTIONKeyPress,InteractiveChange1A2qAAA!111gQ) chkPHookwstool.pf1.pgOptionscheckboxcheckbox chkUnicodewstool*Top = 11 Left = 16 Height = 465 Width = 433 DoCreate = .T. BorderStyle = 2 Caption = "XML Web Service Builder" MaxButton = .F. MinHeight = -1 MinWidth = 300 WindowType = 1 HelpContextID = 1231128 naction = 0 lwsfound = .T. operationclass = operationclasslib = Name = "wsbuilder" CArial, 0, 9, 5, 15, 12, 32, 3, 0 Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 wsconfigTop = 214 Left = 12 Height = 15 Width = 272 FontName = "Tahoma" FontSize = 8 Caption = "Set selected URL as \ %%%"~Ut&U <U_OWEBSERVICEMANAGER+ C7 TU ORETOBJECT_OWEBSERVICEMANAGERTHIS CCUTHISFORM LSTSERVICESINTERACTIVECHANGE CUTHISFORMRELEASE Deactivate,Destroy8Init[ updatelist cmdOK.Click1Q2q2qq222%C^y 2 Th)% ͽ%Rs aU%TCC%CO!C cRetvalue %C lUseCustom (C lAddErrorCode  C U THISFORM CRETVALUE LSTSERVICESLIST LISTINDEX ORETVALUE CHKCUSTOMVALUECHKERRORRELEASEClick,1QQA2)shapeshapewspubLabel6oWebDataSession = 2 Top = 20 Left = 19 Height = 156 Width = 442 Desktop = .T. DoCreate = .T. ShowTips = .T. BorderStyle = 2 Caption = "Visual FoxPro XML Web Services Publisher" MaxButton = .F. MinButton = .F. WindowType = 1 HelpContextID = 1230989 Name = "wspub" lhaderror Reserved. lskiperror Reserved. *processfile Reserved. *checkclass Reserved. *generatews Reserved. *savepos Reserved. *loadpos Reserved. *checkiis Reserved. *checkmethods Reserved. *checkisapi Reserved. bAutoSize = .F. FontName = "Tahoma" FontSize = 8 WordWrap = .T. Caption = "Select specific XML Web service files to generate. Change the file name, location, URL reference and other options if one of the default settings is not appropriate. These settings will be saved." Height = 41 Left = 12 Top = 24 Width = 469 TabIndex = 2 Name = "Label5"  cboInterface pageframelabel  % U T(TC%)T C B%TC %&T C  U LNPOSLCURLTHIS DISPLAYVALUETHISFORMOWEBAVIRDIRSPF1 PGOPTIONS TXTWSDLFILEVALUEAURISInteractiveChange,1AASaA2)wstool.pf1.pgOptionsTop = 132 Left = 492 Height = 23 Width = 24 FontName = "Tahoma" FontSize = 8 Caption = "..." Default = .F. Enabled = .F. TabIndex = 8 Name = "cmdGetDir"  commandbuttonwsconfigtxtPathtextboxtextbox g%.&U%CC "Q%-}TaT-T Data ViewBT-TaTXML VieweG.% (T C xmladapterNT T a$CCC C (  TC  %C QC(T.Net Dataset Cursors:TTaCQC TCC2C&Could not create a Fox cursor from XMLxTaT-T Data ViewULOXMLILCALIASTHISFORM OLEBROWSERVISIBLEGRID1 LBLBROWSECAPTIONLDATASETOADAPTER RETURNVALUEMAPN19_4TOCURRENCYATTACHITEM CBOCURSORSCLEARTABLESCOUNTALIASADDITEM LBLRESULTS LISTINDEXINTERACTIVECHANGE RECORDSOURCEAUTOFITClick,1AARAAaAAAA1!A!A2)F --x=%U TC%C3BCTJ(7R,:,Searching UDDI database for your request....C C R %CC?T -T -"CNo UDDI matches found.xB(C CC  T aT aTCULCSTRITHISFORMTXTUDDIVALUECBOWSCLEAR EDTDETAILSAUDDISEARCHBUSINESS SEARCHSERVICEENABLED CMDSELECTADDITEM LISTINDEXINTERACTIVECHANGEClick,1QAA1brQ!AAA12)- %qU TCTC%CC 6TC C C C C%CC 6TC C C C C%C &)TC C C C TT /%CWSDLC.ASMX T aT aT -T -U LCDESCPANELCWSDLTHISFORMAUDDITHIS LISTINDEX EDTDETAILSVALUELBLWSDLCTARGET CMDSELECTENABLEDInteractiveChange,1aAaAA22A2) xF%0W ?UTTTCwsuddiTC%C CT U LOFORMTHISFORMCNEWWSDLCNEWWS CLASSLIBRARYOREFSHOWCBOWSDLADDITEMVALUEClick,1q1aaA2))label cboWSDLFilecomboboxtextbox lblSchemaURIlabelAutoSize = .T. FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "A\0 .ListIndex=1 THIS.txtOperation.Value = .DisplayValue ENDIF ENDWITH * Create array of existing Operations for quick lookup later. lnOperations=THIS.oCallee.colOperations.Count IF lnOperations>0 DIMENSION THIS.aOperations[lnOperations] FOR i = 1 TO lnOperations THIS.aOperations[m.i] = THIS.oCallee.colOperations.Item(m.i).wsOperation ENDFOR ENDIF THIS.WSDL= THIS.oCallee.WSDL THIS.lblWSDL.ctarget = THIS.oCallee.WSDL * User clicked Edit button IF THIS.lEditMode WITH THIS.oCallee.oOperation THISFORM.txtOperation.Value = TRANSFORM(.wsOperation) THISFORM.edtOperation.Value = TRANSFORM(.wsDesc) THISFORM.cboMethods.DisplayValue = TRANSFORM(.wsMethod) THISFORM.wsparmnum = .wsparmnum THISFORM.chkOffline.Value = .lOffline THISFORM.cboParms.ListIndex = .nParmPrompt THISFORM.colParms.Remove(-1) FOR i = 1 TO .colParms.Count THISFORM.colParms.Add(.colParms.Item(m.i)) ENDFOR ENDWITH ENDIF THIS.oCallee.nAction = 0 THIS.UpdateMethod(!THIS.lEditMode) ENDPROC PROCEDURE updatemethod LPARAMETERS lInterChange LOCAL lcParms, lcDesc, lcMethod, lnCounter lcDesc = "" SELECT (THISFORM.oCallee.oWeb.cWSAlias) WITH THIS IF !THIS.oCallee.lWSFound .wsSyntax = "" .wsdocumentation = "" .wsParmnum = THISFORM.wsparmnum ELSE .wsSyntax = ALLTRIM(GETWORDNUM(Tips,.cboMethods.ListIndex,CHR(13)+CHR(10))) lcParms = ALLTRIM(STREXTRACT(.wsSyntax, "(", ")")) .wsParmnum = IIF(EMPTY(lcParms),0,OCCURS(",",lcParms)+1) IF !EMPTY(ALLTRIM(prefs)) lcDesc = ALLTRIM(GETWORDNUM(Prefs,.cboMethods.ListIndex, CHR(13)+CHR(10))) .wsdocumentation = IIF(GETWORDCOUNT(lcDesc)<2,"",ALLTRIM(SUBSTR(lcDesc,ATC(" ", lcDesc)))) ENDIF ENDIF .wsMethod = .cboMethods.DisplayValue .cboMethods.Enabled = .cboMethods.ListCount>0 IF lInterChange * Find next available number lcMethod = .wsMethod lnCounter = 2 DO WHILE .T. IF ASCAN(THIS.aOperations, lcMethod,-1,-1,-1,7)=0 EXIT ENDIF IF THIS.lEditmode AND UPPER(THIS.oCallee.oOperation.wsOperation)==UPPER(lcMethod) EXIT ENDIF lcMethod = .wsMethod + " (#" + TRANSFORM(lnCounter) + ")" lnCounter = lnCounter + 1 ENDDO .txtOperation.Value = lcMethod .coLParms.wsSyntax = .wsSyntax .coLParms.GenParms() ENDIF ENDWITH THIS.UpdateParms() ENDPROC PROCEDURE updateparms LOCAL lcParmExpr, loItem, lcDescPane, lcDesc WITH THIS .cboParms.Enabled = .wsParmnum>0 .cmdParms.Enabled = IIF(!.cboParms.Enabled, .F., .cboParms.ListIndex=1) lcParmExpr = "" IF .colParms.Count#0 FOR EACH loItem IN .colParms IF !EMPTY(loItem.InputControl) lcParmExpr = lcParmExpr + GETWORDNUM(loItem.InputControl,GETWORDCOUNT(loItem.InputControl,"."),".") + "." + loItem.InputProperty + "," ELSE lcParmExpr = lcParmExpr + TRANSFORM(loItem.InputValue) + "," ENDIF ENDFOR lcParmExpr =LEFT(lcParmExpr , LEN(lcParmExpr )-1) ENDIF * Update edtDesc lcDescPane="" IF .cboMethods.ListCount>0 AND !EMPTY(.wsSyntax) lcDescPane = lcDescPane + SYNTAX_LOC + .wsSyntax + CRLF + CRLF ENDIF IF !EMPTY(.wsdocumentation) lcDescPane = lcDescPane + DESCRIPT_LOC + .wsdocumentation + CRLF + CRLF ENDIF IF !EMPTY(lcParmExpr) OR LEFT(lcParmExpr,1)="," lcDescPane = lcDescPane + YOURPARMS_LOC + .wsMethod +"(" + lcParmExpr +")" +CRLF + CRLF ENDIF lcDescPane = lcDescPane + .wsdl + CRLF + CRLF THIS.edtDesc.Value = lcDescPane ENDWITH ENDPROC PROCEDURE Init LPARAMETER toObject2, tuSource2, tlSkipSearch2 RETURN ENDPROC FontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 22 Left = 132 ReadOnly = .T. TabIndex = 7 Top = 132 Width = 352 Name = "txtPath" wsconfiglblPathlabellabelwsconfig_ws3.h&- wsfoxcode_ws3.hPixelsClasscustom wsfoxcodelhaderror Whether an error occurred. lskiperror Whether to skip error reporting. cwsalias Reference to the Fox Web Service table. nsavearea Work area to save. oweb Object reference to web service utility handler. cproxygenclass Name of class to handle web service proxy code generation. cproxygenclasslib Name of class library containing class to handle web service proxy code generation. *gettip This code returns web service method parameter quick info used for Intellisense. *getmethods This code returns web service methods used for Intellisense. *main Main routine that gets called by IntelliSense engine. *erroralert Displays error message. *about About this class. *getservice Parses editor content to determine reference to web service. *getproxyclass Routine used to set the proxy class and classlib properties used to generate web service proxy code. *getproxyobject Gets reference to proxy code generation object. *getnextvar Finds next variable name. ! |B%U./TCregistryCQffc\registry.vcx Te%C;CLSID\{3FEB0525-8310-44ab-9CCC-E0F49ED513B0}\InProcServer32 '%Cwsdlgen#!TC \wsdlgen3.exe%C0RUN /n "&lcFile." CULCVALUELCFILELOREG GETREGKEYTHISFORMRELEASEClick,1QQAAA2)PROCEDURE Click * Special handling if first time (Default Mode). Set default location to "*" IF THISFORM.lDefaultMode THISFORM.oWeb.UpdatePrefs("URI","*") ENDIF THISFORM.RELEASE() ENDPROC wstool.pf1.pgURIs txtSchemaURIPROCEDURE InteractiveChange LOCAL lcDescPane, lcWSDL lcWSDL = THISFORM.aUDDI[THIS.ListIndex,5] lcDescPane = THISFORM.aUDDI[THIS.ListIndex,4] IF !EMPTY(THISFORM.aUDDI[THIS.ListIndex,1]) lcDescPane = lcDescPane + CRLF + CRLF + THISFORM.aUDDI[THIS.ListIndex,1] ENDIF IF !EMPTY(THISFORM.aUDDI[THIS.ListIndex,2]) lcDescPane = lcDescPane + CRLF + CRLF + THISFORM.aUDDI[THIS.ListIndex,2] ENDIF IF !EMPTY(lcWSDL) lcDescPane = lcDescPane + CRLF + CRLF + lcWSDL ENDIF THISFORM.edtDetails.Value = lcDescPane THISFORM.lblWSDL.cTarget = lcWSDL IF ATC("WSDL", lcWSDL)#0 OR ATC(".ASMX",lcWSDL)#0 THISFORM.cmdSelect.Enabled= .T. THISFORM.lblWSDL.Enabled=.T. ELSE THISFORM.cmdSelect.Enabled= .F. THISFORM.lblWSDL.Enabled=.F. ENDIF ENDPROC FontName = "Tahoma" FontSize = 8 ControlSource = "" Height = 23 Left = 12 TabIndex = 2 Top = 26 Width = 396 Name = "txtUDDI" Label3label cboCOMFilewspub lblCOMFilewstoolcomboboxcomboboxwspub[ BBm%:&}UQ TCW0%C,C~CfC&CC (C )!CC  !CC  % TC(TT8J FU LCSAVEAREATHISOWEB CHECKWSDBF LSTSERVICESCLEARTYPE ADDLISTITEMCLASSNAMEUNIQUEID NEWITEMIDURI LISTCOUNT LISTINDEXINTERACTIVECHANGELBLWSDLCTARGETLBLURICAPTION$%ONGZ UTHIS CSAVENOTIFYb%CO,TTCNOTIFYvGZ CU ORETOBJECTTHIS ORETVALUE CSAVENOTIFY UPDATELIST BUTHIS CRETVALUE updatelist,Destroy?InitzUnload1qAQaAq111AAA3aqA3qQAq32!$+)BQ 888%U[TC%C GCTips CULCWSDLTHISFORMCBOWSDL DISPLAYVALUEOWEB UPDATEPREFSRELEASEClick,1qQA2)8FontName = "Tahoma" FontSize = 8 ControlSource = "" Enabled = .F. Height = 22 Left = 192 TabIndex = 10 Top = 163 Width = 324 Name = "txtNewVirDir" ErasePage = .T. PageCount = 3 TabStyle = 1 Top = 80 Left = 12 Width = 470 Height = 308 TabIndex = 4 TabOrientation = 1 Name = "pf1" Page1.FontName = "Tahoma" Page1.FontSize = 8 Page1.FontCharSet = 0 Page1.Caption = "Options" Page1.Name = "pgOptions" Page2.FontName = "Tahoma" Page2.FontSize = 8 Page2.FontCharSet = 0 Page2.Caption = "Methods" Page2.Name = "pgMethods" Page3.FontName = "Tahoma" Page3.FontSize = 8 Page3.FontCharSet = 0 Page3.Caption = "Namespaces" Page3.Name = "pgURIs" RTop = 397 Left = 12 Height = 21 Width = 24 lusingwizard = .T. Name = "oWeb" Label5wstoollabellabel commandbutton commandbuttoncmdOpenwspublabellabelLabel2wspubcomboboxz aa:%U9TCTC%C0 :C.You must first select a valid COM server file.xB%C/C#You must select a valid class name.xB+%C  B%TCwstool  C U LOWS LCCOMFILELCCLASSTHISFORM CBOCOMFILE DISPLAYVALUE CBOINTERFACEOWEBAUTOWS LPREFSLOADED CLASSLIBRARYSHOWClick,1RQAAAAAAR2)a &%C U  5 T T5TCwsconfiglcURL lcDefPathT- CTC%CB*TCCR//6T #( W(%CC  fCfST  BC T %CC "C$TC$TCULOCONFIGILCURL LCDEFPATHTHISFORM CLASSLIBRARY LDEFAULTMODESHOWPF1 PGOPTIONS TXTWSDLFILEVALUE CBOWSDLFILE LISTCOUNTLIST LISTINDEXADDITEM DISPLAYVALUEAURISClick,1QAA3AAAr!ABA2)MHeight = 239 Width = 542 Desktop = .T. DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "Visual FoxPro XML Web Service Location" MaxButton = .F. MinButton = .F. WindowType = 1 AlwaysOnTop = .T. HelpContextID = 1231136 ldefaultmode = .F. curllocation = curlpath = cdefuri = cdefpath = Name = "wsconfig" textboxtextboxtextboxPROCEDURE gettip LPARAMETER lcLine LOCAL i, lcMethod, lcTip, aTmp, lnLines, lcExpr lcTip="" lcExpr = ALLTRIM(SUBSTR(lcLine,RAT(".",lcLine)+1)) DIMENSION aTmp[1] lnLines = ALINES(aTmp,tips) FOR i = 1 TO lnLines lcMethod = aTmp[m.i] lcMethod = GETWORDNUM(lcMethod,GETWORDCOUNT(lcMethod,"."),".") IF !EMPTY(lcMethod) AND ATC(lcExpr,lcMethod)#0 lcTip = lcMethod EXIT ENDIF ENDFOR RETURN ALLTRIM(lcTip) ENDPROC PROCEDURE getmethods LPARAMETERS aMeths LOCAL i,lcMethod,lnCount,aTmp,lnLines,lcDesc lnCount=0 DIMENSION aTmp[1] IF EMPTY(ALLTRIM(Prefs)) lnLines = ALINES(aTmp, menu) ELSE lnLines = ALINES(aTmp, prefs) ENDIF FOR i = 1 TO lnLines lcDesc="" lcMethod = aTmp[m.i] lcMethod = GETWORDNUM(lcMethod, 1) IF GETWORDCOUNT(aTmp[m.i])>1 lcDesc = ALLTRIM(SUBSTR(aTmp[m.i],ATC(" ",aTmp[m.i]))) ENDIF IF !EMPTY(lcMethod) lnCount = lnCount+1 DIMENSION aMeths[lnCount,2] aMeths[lnCount,1]=lcMethod && method name aMeths[lnCount,2]=lcDesc && description ENDIF ENDFOR RETURN lnCount ENDPROC PROCEDURE main * This is Main routine that gets called from IntelliSense script (XML Web Service). LPARAMETER oFoxCode LOCAL lnMethods, laMethods, lcTip, lcTrigger, loWSPicker, loParm, lcGenCode, loProxy lcTrigger = RIGHT(oFoxCode.FullLine, 1) oFoxcode.ValueType = "V" IF oFoxcode.Location=0 &&Command Window RETURN oFoxcode.UserTyped ENDIF DO CASE CASE UPPER(ALLTRIM(oFoxCode.Abbrev))="WS" * Handle custom WS keyboard shortcut here. * Call Web Service picker form. loParm = CREATEOBJECT("Custom") loWSPicker = NEWOBJECT("wspicker", THIS.ClassLibrary, "", loParm) loWSPicker.Show() IF TYPE("loParm.cRetvalue")#"C" OR EMPTY(ALLTRIM(loParm.cRetvalue)) RETURN "" ENDIF * Call proxy code gen class to get object reference loProxy = THIS.GetProxyObject(loParm.cRetvalue) IF VARTYPE(loProxy) # "O" RETURN "" ENDIF IF TYPE("loParm.lUseCustom")="L" loProxy.lCustomClientCode=loParm.lUseCustom ENDIF IF TYPE("loParm.lAddErrorCode")="L" loProxy.lAddErrorCode=loParm.lAddErrorCode ENDIF * Call routine to get code -- note: could set properties on object first if needed lcGenCode = loProxy.GetProxyCode() IF !EMPTY(lcGenCode) KEYBOARD '{BACKSPACE}' && adjust for IntelliSense ENDIF RETURN lcGenCode CASE lcTrigger = "." * Handle list of XML Web service operations (methods). This is a List Members list. * Try to find web service. Note: if not found, then skip it since user removed reference marker. IF !THIS.GetService(oFoxCode.UserTyped, lcTrigger) RETURN "" ENDIF * Get list of methods to display DIMENSION laMethods[1] lnMethods = THIS.GetMethods(@laMethods) IF lnMethods # 0 DIMENSION oFoxcode.Items[lnMethods,2] FOR i = 1 TO lnMethods oFoxcode.Items[m.i,1] = laMethods[m.i,1] && method name oFoxcode.Items[m.i,2] = laMethods[m.i,2] && method description oFoxcode.Icon = HOME()+"ffc\graphics\method.bmp" ENDFOR oFoxcode.ValueType = "L" ENDIF CASE lcTrigger = "(" * Handle list of XML Web service operation (method) parameters. This is Quick Info tip. IF !THIS.GetService(oFoxCode.UserTyped, lcTrigger) RETURN "" ENDIF lcTip = THIS.GetTip(oFoxCode.FullLine) IF !EMPTY(lcTip) oFoxcode.ValueTip = lcTip oFoxcode.ValueType = "T" ENDIF CASE ATC("XML Web Service", oFoxcode.MenuItem) # 0 RETURN ["XML Web Service"] ENDCASE RETURN "" ENDPROC PROCEDURE erroralert LPARAMETERS tcMessage MESSAGEBOX(tcMessage) ENDPROC PROCEDURE about *!* This class is the core class used for following: *!* - Handing of IntelliSense for registered XML Web services ENDPROC PROCEDURE getservice LPARAMETER lcUserTyped, lcTrigger * This routine retrieves the XML Web service info from editor. LOCAL lcOps, lcUserTyped, lnWordCount, lcLastWord , laEnv LOCAL lnWinHdl, lcfxtoollib, laLines, lcStr, lcSearchExpr, lnPos LOCAL lcWSInfo, lcURI, lcService, lcPort DO CASE CASE lcTrigger="." lcOps = [><(:;,?/[-+*&^%$#@!.=] lcUserTyped = ALLTRIM(lcUserTyped) lcUserTyped = CHRTRAN(lcUserTyped, lcOps, REPLICATE(" ", LEN(lcOps))) lnWordCount = GETWORDCOUNT(lcUserTyped) lcLastWord = ALLTRIM(GETWORDNUM(lcUserTyped,lnWordCount)) CASE lcTrigger="(" lnWordCount = GETWORDCOUNT(lcUserTyped,".") lcLastWord = ALLTRIM(GETWORDNUM(lcUserTyped,lnWordCount-1,".")) OTHERWISE RETURN .F. ENDCASE lcfxtoollib = SYS(2004)+"FOXTOOLS.FLL" IF !FILE(lcfxtoollib) RETURN .F. ENDIF SET LIBRARY TO (m.lcfxtoollib) ADDITIVE lnWinHdl = _WONTOP() _wselect(lnWinHdl) DIMENSION laEnv[25] _EdGetEnv(lnWinHdl ,@laEnv) lcStr = _EDGETSTR(lnWinHdl , 0, laEnv[17]) DIMENSION laLines[1] ALINES(laLines,lcStr) * #DEFINE WSMARKER "*__VFPWSDef__: " * LOCAL myWebService AS "XML Web Service" * *__VFPWSDef__: myWebService = http://myserver/myservice/foxws.wsdl, foxws, class1SoapPort lcSearchExpr = WSMARKER + lcLastWord+" = " lnPos=ASCAN(laLines,lcSearchExpr,-1,-1,1,5) IF lnPos=0 RETURN .F. ENDIF lcWSInfo = SUBSTR(laLines[lnPos],LEN(lcSearchExpr)) lcURI = ALLTRIM(GETWORDNUM(lcWSInfo,1,",")) && URI lcService = ALLTRIM(GETWORDNUM(lcWSInfo,2,",")) && Service lcPort = ALLTRIM(GETWORDNUM(lcWSInfo,3,",")) && Port LOCATE FOR ALLTRIM(URI)=lcURI AND ALLTRIM(Name)=lcService AND ; ALLTRIM(Port)=lcPort AND UPPER(Type)="C" IF !FOUND() * This handles case for WS not registered on a specific machine. IF MESSAGEBOX(MB_WSNOTFOUND_LOC+MB_WSNOTFOUND1_LOC,36)=7 RETURN .F. ENDIF IF !THIS.oWeb.AddFoxCode(lcURI, .T.) THIS.oWeb.Alert(MB_ERRNOWSDL_LOC) RETURN .F. ENDIF LOCATE FOR ALLTRIM(URI)=lcURI AND ALLTRIM(Name)=lcService AND ; ALLTRIM(Port)=lcPort AND UPPER(Type)="C" IF !FOUND() && problem registering RETURN .F. ENDIF ENDIF ENDPROC PROCEDURE getproxyclass * Get cProxyGenClass PEMs in case user wants to use customized Proxy Gen class. * These get stored in the FOXWS3 file. The custom proxy gen class must have a * GetProxyCode method which returns proxy code to insert. * Need to check here for user-defined class IF VARTYPE(THIS.cProxyGenClass)#"C" OR EMPTY(ALLTRIM(THIS.cProxyGenClass)) THIS.cProxyGenClass = DEFPROXYGEN_CLASS ENDIF IF VARTYPE(THIS.cProxyGenClasslib)#"C" OR EMPTY(ALLTRIM(THIS.cProxyGenClasslib)) THIS.cProxyGenClasslib = THIS.ClassLibrary ENDIF ENDPROC PROCEDURE getproxyobject LPARAMETERS tcWSID LOCAL loProxy IF VARTYPE(tcWSID) # "C" OR EMPTY(ALLTRIM(tcWSID)) RETURN "" ENDIF * Try to locate web service SELECT (THIS.cWsalias) LOCATE FOR ALLTRIM(UniqueID) == ALLTRIM(tcWSID) IF !FOUND() RETURN "" ENDIF * Call proxy code gen class THIS.lSkipError=.T. THIS.GetProxyClass() loProxy = NEWOBJECT(THIS.cProxyGenClass, THIS.cProxyGenClassLib) THIS.lSkipError=.F. IF VARTYPE(loProxy)#"O" RETURN "" ENDIF RETURN loProxy ENDPROC PROCEDURE getnextvar * Retrieves next available variable name. LOCAL lcfxtoollib, lnWinHdl, lcStr, laEnv, lcVar, lnCount lcfxtoollib = SYS(2004)+"FOXTOOLS.FLL" IF !FILE(lcfxtoollib) RETURN .F. ENDIF SET LIBRARY TO (m.lcfxtoollib) ADDITIVE lnWinHdl = _WONTOP() _wselect(lnWinHdl) DIMENSION laEnv[25] _EdGetEnv(lnWinHdl ,@laEnv) lcStr = _EDGETSTR(lnWinHdl , 0, laEnv[17]) lcVar = WSGEN_DEFAULTVAR lnCount = 2 DO WHILE .T. IF ATC("LOCAL "+lcVar, lcStr)=0 EXIT ENDIF lcVar = WSGEN_DEFAULTVAR+TRANSFORM(lnCount) lnCount = lnCount+1 ENDDO RETURN lcVar ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.lhaderror=.T. IF THIS.lSkiperror RETURN ENDIF LOCAL lcMessage lcMessage = MESSAGE() IF nError = 3 lcMessage = lcMessage + " " + FOXWSINUSE_LOC ENDIF THIS.ErrorAlert(lcMessage) ENDPROC PROCEDURE Destroy IF !EMPTY(THIS.cWSAlias) AND SELECT(THIS.cWSAlias)#0 SELECT (THIS.cWSAlias) USE ENDIF SELECT (THIS.nSaveArea) ENDPROC PROCEDURE Init * Check for our FOXWS3 file first THIS.nSaveArea = SELECT() THIS.oWeb = NEWOBJECT("_webservices", THIS.ClassLibrary) IF VARTYPE(THIS.oWeb)#"O" RETURN .F. ENDIF IF !THIS.oWeb.Checkwsdbf() RETURN .F. ENDIF THIS.cWSAlias = THIS.oWeb.cWSAlias SYS(2030,1) ENDPROC 0cwsalias = nsavearea = 0 Name = "wsfoxcode" customimgVarwspub8PROCEDURE Click MESSAGEBOX(MB_NOVARIANT_LOC) ENDPROC wstoolotypelib _utility.vcxcustomlabel _webserviceswstoolUAutoSize = .T. FontName = "Tahoma" FontSize = 8 WordWrap = .T. BackStyle = 0 Caption = "Enter the name for your Web service. This is also the name used for the generated WSDL (and optional ASP) files. Specify the URI location to reference in the WSDL file." Height = 28 Left = 11 Top = 9 Width = 432 TabIndex = 5 Name = "Label2" txtNamewstool.pf1.pgOptionslabellabelPROCEDURE Click LOCAL loWS, lcCOMFile, lcClass lcCOMFile = ALLTRIM(THISFORM.cboCOMFile.DisplayValue) lcClass = ALLTRIM(THISFORM.cboInterface.DisplayValue) IF !FILE(lcCOMFile) MESSAGEBOX(NODLL_LOC) RETURN ENDIF IF EMPTY(lcClass) MESSAGEBOX(NOCLASS_LOC) RETURN ENDIF * set default settings IF !THISFORM.oWeb.AutoWS(lcCOMFile, lcClass) AND !THISFORM.oWeb.lPrefsLoaded RETURN ENDIF loWS = NEWOBJECT("wstool",THISFORM.ClassLibrary,"",THISFORM.oWeb) loWS.Show() ENDPROC  _ws3utils.vcxwspub_typelibAutoSize = .T. FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "Listener \0 THIS.lstServices.ListIndex=1 THIS.lstServices.InteractiveChange() ELSE THIS.lblWSDL.ctarget = "" THIS.lblURI.Caption = "" ENDIF ENDIF CATCH FINALLY SELECT (lcSaveArea) ENDTRY ENDPROC PROCEDURE Destroy IF THIS.cSaveNotify="ON" SET NOTIFY CURSOR ON ENDIF ENDPROC PROCEDURE Init LPARAMETERS oRetObject IF VARTYPE(oRetObject)="O" THIS.oRetValue = oRetObject ENDIF THIS.cSaveNotify=SET("NOTIFY",1) SET NOTIFY CURSOR OFF THIS.updatelist() ENDPROC PROCEDURE Unload RETURN THIS.cRetValue ENDPROC  DataSession = 2 Top = 48 Left = 101 Height = 258 Width = 384 Desktop = .T. DoCreate = .T. ShowTips = .T. BorderStyle = 2 Caption = "Select" MaxButton = .F. WindowType = 1 AlwaysOnTop = .T. cretvalue = oretvalue = csavenotify = Name = "wspicker" oref Reserved. ^auddi[1,0] Array of UDDI Web Services found. *searchbusiness Method to search. *cleanaccesspoint *searchservice *updateservicearray =61TCC/CC/6-TIIS://LocalHost/w3svc/1/Root!%C {CoError creating new virtual directory. Check to see that IIS is working properly or name does not already exist.xB-%CCR/T/%C T!STORE lcVirDir TO &lcVarName. %C FTSTORE lcPath TO &lcVarName. %  '%CURIC FR,6A default web service location was successfully set...ULCVIRDIRLCNAMELCPATH LCVARNAMELCPARENTLCCHILDTHISFORMTXTPATHVALUE OPGDEFAULTVD CBOVIRDIR DISPLAYVALUETEXT TXTNEWVIRDIROWEB CREATEVIRDIRTHIS CURLLOCATIONCURLPATH LDEFAULTMODE CHKDEFAULT UPDATEPREFSm %CC0T%CCYT CU TCURIVARREF TCPATHVARREFTHIS CURLLOCATIONCURLPATHSETUP%Q:T'Select Default XML Web Service Location2TSelect XML Web Service LocationT UNSTYLETHIS LDEFAULTMODELBLTYPECAPTION CHKDEFAULTVISIBLE TC!%C  fT T-"(C %%CC  fCf#TC  Ta!*T Ca 6ULCVDIRILFOUNDTHIS CBOVIRDIR DISPLAYVALUECDEFURITXTPATHVALUECDEFPATHOWEBAVIRDIRS CMDGETDIRENABLEDSTYLEsetup, getwslocationInit Showf RefreshV 1SAA Acq1AA2aAaaA3Qq11A"qAQqA2qA!AA3A3AraAA3QAQA3q!Aq3Ra!Q1AAAA2L )Jg & cSA n[ x)  E%S)UTC%CLTC H] CUCBYou must enter a WSDL file name for generation option(s) selected. B- C uC|The WSDL location contains a space which is not currently supported in URLs by the Visual FoxPro XML Web Service extensions. B-28R,:-Attempting to connect to XML Web service.....TCa R % -TError generating ٯIntelliSense scripts. Check for a valid WSDL URL location or invalid WSDL content. The WSDL file may have also been in use -- try regenerating the XML Web Service files again. Cz%CCx-TC C C C CC wBC6Finished generating IntelliSense scripts successfully.x BU LCWSDLLSUCCESSLAWSERRS LCERRMESSAGETHISFORMCBOWSDLTEXT DISPLAYVALUEOWEBALERT ADDFOXCODEv%CTIPSQ%CC MCC%oB-ULCDEFURITHISOWEBGETPREFSCBOWSDLADDITEM LHADERROR regwebservice,Init%12SQAQqqqQ AA!AA3q!QAA2qA2-H&%)/ l%m#UC %CfCTC%C., ___iTloWSTloTCTC T C T C %C TaTa Ta (!BC C6ULSUCCESSLCCLASSTYPECLASSTHISCGENVAR CGENSERVICENAMECGENPORTPORTCGENWSDLURICGENWSMLWSML LINCLUDEWSMLLADDFOXCODEHEADER LOEXCEPTION GENPROXYCODE CxU TCMESSAGEU  TT~%KTLOCAL  AS "XML Web Service"C C QT* LOCAL  AS "MSSOAP.SoapClient30"C C  T% M(`lf * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service.e_ *__VFPWSDef__: <> = <> , <> , <># LOCAL loException,lcErrorMsg=7 <> = CREATEOBJECT("MSSOAP.SoapClient30")60 <>.MSSoapInit(<>)SM * Call your XML Web service here. ex: leResult=<>.SomeMethod() <> B M(`ke* Do not remove or alter following line. It is used to support IntelliSense for your XML Web service.d^*__VFPWSDef__: <> = <> , <> , <>"LOCAL loException,lcErrorMsg TRY=7 <> = CREATEOBJECT("MSSOAP.SoapClient30")60 <>.MSSoapInit(<>)SM * Call your XML Web service here. ex: leResult=<>.SomeMethod() <>CATCH TO loExceptionTN lcErrorMsg="Error: "+TRANSFORM(loException.Errorno)+" - "+loException.Message DO CASE)# CASE VARTYPE(<>)#"O"5/ * Handle SOAP error connecting to web service.( CASE !EMPTY(<>.FaultCode)=7 lcErrorMsg=lcErrorMsg+CHR(13)+<>.Detail*$ * Handle SOAP error calling method OTHERWISE * Handle other error ENDCASE# * Use for debugging purposes MESSAGEBOX(lcErrorMsg) FINALLY ENDTRY BULCSTR LCPOSMARKERTHISLADDFOXCODEHEADERCGENVAR LADDERRORCODEi,TCC WSHandler6`TCC93IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_ws3client.vcx"[]6.TCC  SetupClient 6.TCC  loWSHandler 6 TT~% KTLOCAL   AS "XML Web Service"C C QT* LOCAL   AS "MSSOAP.SoapClient30"C C  T% "M(`lf * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service.e_ *__VFPWSDef__: <> = <> , <> , <>93 LOCAL loException, lcErrorMsg, <>NH <> = NEWOBJECT("<>",<>)VP <> = <>.<>(<>)TN * Call your XML Web service here. ex: leResult=<>.SomeMethod() <> B M(`ke* Do not remove or alter following line. It is used to support IntelliSense for your XML Web service.d^*__VFPWSDef__: <> = <> , <> , <>82LOCAL loException, lcErrorMsg, <> TRYNH <> = NEWOBJECT("<>",<>)VP <> = <>.<>(<>)VP * Call your XML Web service here. ex: leResult = <>.SomeMethod() <>CATCH TO loExceptionTN lcErrorMsg="Error: "+TRANSFORM(loException.Errorno)+" - "+loException.Message DO CASE)# CASE VARTYPE(<>)#"O"5/ * Handle SOAP error connecting to web service.( CASE !EMPTY(<>.FaultCode)*$ * Handle SOAP error calling method=7 lcErrorMsg=lcErrorMsg+CHR(13)+<>.Detail OTHERWISE * Handle other error ENDCASE# * Use for debugging purposes MESSAGEBOX(lcErrorMsg) FINALLY ENDTRY BU LCPROXYCLASSLCPROXYCLASSLIBLCPROXYCLASSVARLCPROXYCLASSINITLCSTR LCPOSMARKERTHIS CPROXYCLASSCPROXYCLASSLIBCPROXYCLASSINIT CPROXYVARLADDFOXCODEHEADERCGENVAR LADDERRORCODEE$%CC C - B&%CC CC yTloWSTa%CCT%CCT@% CC C .asmx?wsdl %T H6* C C C }T"" C;T"", "", ""2JT"", "", "", """BC C C 6U THISCGENWSDLCGENVARLADDFOXCODEHEADER CGENSERVICECGENPORT LINCLUDEWSMLCGENWSML CGENPARMSLCUSTOMCLIENTCODEDEFAULTCLASSCODEDEFAULTSOAPCODETa%8B TCE%QT ;Make sure your FOXWS3.DBF web services table is not opened.CUNERRORCMETHODNLINE LCMESSAGETHIS LHADERROR LSKIPERROR ERRORALERT getproxycode, erroralert aboutEdefaultsoapcodeLdefaultclasscoden genproxycodeError1AAaA!!!!1AAB2q35AQ1a1aAAA!a1aAQ1A2AQaAaAAAaaaAQ1aA3GAaAAAAA!A#2qAAA2M$i){ .K hd ' )#PROCEDURE Click IF THISFORM.cboVirDir.ListCount=0 RETURN ENDIF THISFORM.cboVirDir.Style = IIF(THIS.Value=1,0,2) THISFORM.txtNewVirDir.Enabled = (THIS.Value#1) THISFORM.cmdGetDir.Enabled = (THIS.Value#1) IF THIS.Value=2 THISFORM.cmdOK.Caption=BTN_CREATE_LOC THISFORM.cboVirDir.Value=THISFORM.cboVirDir.ListItem[1] ELSE THISFORM.cmdOK.Caption=BTN_SELECT_LOC IF THISFORM.cboVirDir.ListCount>0 THISFORM.cboVirDir.DisplayValue=THISFORM.cboVirDir.ListItem[THISFORM.cboVirDir.ListCount] ENDIF ENDIF THISFORM.Refresh() ENDPROC AutoSize = .F. ButtonCount = 2 Value = 1 ControlSource = "" Height = 126 Left = 12 Top = 72 Width = 516 TabIndex = 3 Name = "opgDefaultVD" Option1.FontName = "Tahoma" Option1.FontSize = 8 Option1.Caption = "\ Root EntryWmNOleObjectDataAccessObjSiteData&\ChangedPropsKѽj(6(!C4\N}#.ͫ\$89368265E-85FE-11d1-8BE3-0000F8754DA16-00C04FB6678B} C:HideColumnHeadersL LabelEdit I  \'Q(R KQDBTahoma Methods:\MousePointer I View I  CheckboxesLW >>&%;mU '     /%Ct CC CC BTTCF%CCJRCFCould not access Web service table FOXWS3. Make sure it is not in use.xB- %C4 mBTCT C!  C "aC C (T C (% BTC T#$C#%T& T'(C)%C.ASMX)T*+aT*,a1T*(C'(C?'(\ T%#-S0T CwsParmsCQFFC\_ws3client.vcxT .# C /C 0 T%#-#-(#-T  T#"T C #1,TCC #23@6 (/*TlaParms[C _]% #- T,T()JTC WSHandlerCCh CQFFC\6_ws3client.vcx%CC42 T5CC)C!C76_%T5CC)C!C7C46"leRetVal = loWSfox1.&lcMethod. ( T a+TError: C8_ - 9 H C5OK%C: GKTCall to the Web service failed:C C C C ; C5< xTC 5=2T> % 2(#-."%C #236#2 ? ReturnValueC * HCl ] T C CTC %C=<TCC 꾛 C OTC _# CleRetVal.lengthbN% TMB_NODISPLAY_LOC% @! 0TC IsDataSetCC 2A 꾸 %o TBaM(`/) .( 5/ <>5/ <>  T TC 2C%CO TC 2DTA 3T&TA2l TG` G`(Object Members TC b TE(\ %EC  .<>:9 0lcValue = TRANSFORM(leRetVal.&laPEMs[m.i,1])  <>A TEC G`(G`$TCCCC =<TF+ TG+z %J G.TCQ __testws.xmlCCGHITJTBTK,av TFLTK+- (M UN TCSERVICEIDTCMETHOD LOEXCEPTION LCERRORMSG LOWSHANDLERLCSYNTAXLAPARMSLCMETHODLCPARMS LHADERRORLNPOSLATIPSLERETVAL LOPARMFORMI LCBYREFCHAR LHASDATASET LCTEMPSTRLHASHTML LCTMPFILELCRETVALLNCOUNTLAPEMSLONODETHIS CSERVICEIDCMETHODOWEB CHECKWSDBFCWSALIASUNIQUEIDLBLWSCAPTIONNAMETIPSCOLPARMSWSSYNTAXGENPARMS LBLMETHODLBLWSDLCTARGETURI LBLWEBTESTVISIBLEENABLEDCOUNT OCOLPARMSSETUPWSSHOWGETPARMITEMISBYREFWSMLLOWSFOX1 SETUPCLIENTPORTERRORNOMESSAGESOAPERRORSTRINGSOAPERRORDETAIL FAULTCODEDETAIL RETURNVALUE ADDPROPERTYLENGTHXMLLDATASET PARENTNODE OWNERDOCUMENT LCLASTPEM EDTRESULTS OLEBROWSEROBJECT NAVIGATE2XMLFILE LBLBROWSEVALUELOERROR9%%CC C 2 <UTHISCFORMREFCUTHIS _RESIZABLE1ADJUSTCONTROLSsetupws,DestroyResize1rqqAA!AAAAQAA!32QAr1Aq2Q!A!AAAQA!Q2A1BAaAAAARqQAR2AQQ1AqQq1AAAAqQqqAA1AqAaaBCA1aq1AA3QA21 'H)>4PROCEDURE updatesets LOCAL lcURI IF VARTYPE(THIS.oWebParm) = "O" WITH THIS.oWebParm .cService = ALLTRIM(THIS.pf1.pgOptions.txtName.Value) lcURI = ALLTRIM(THIS.pf1.pgOptions.cboWSDLFile.DisplayValue) lcURI = IIF(RIGHT(lcURI,1)="/", lcURI, lcURI+"/") .cWSDLListener = lcURI + .cService + ".wsdl" .cASPListener = lcURI + .cService + ".asp" .cWSDLfile = ADDBS(ALLTRIM(THIS.pf1.pgOptions.txtWSDLFile.Value)) + .cService + ".wsdl" .cASPfile = ADDBS(ALLTRIM(THIS.pf1.pgOptions.txtWSDLFile.Value)) + .cService + ".asp" .cAppName = ALLTRIM(THIS.pf1.pgOptions.txtAppName.Value) .lUseIsapi = (THIS.pf1.pgOptions.opgListener.Value=1) .lUseJScript = (THIS.pf1.pgOptions.opgScript.Value=2) .lUnicode = THIS.pf1.pgOptions.chkUnicode.Value IF THIS.pf1.pgOptions.chkPHook.Enabled AND THIS.pf1.pgOptions.chkPHook.Value#.lUsePHook .lUsePHook = THIS.pf1.pgOptions.chkPHook.Value .lChangePHook = .T. ENDIF .cURI1 = ALLTRIM(THIS.pf1.pguRIs.txtWSDLURI.Value) .cURI2 = ALLTRIM(THIS.pf1.pguRIs.txtSchemaURI.Value) .cURI3 = ALLTRIM(THIS.pf1.pguRIs.txtMessageURI.Value) .cURI4 = ALLTRIM(THIS.pf1.pguRIs.txtActionURI.Value) DIMENSION .aMethods[1] .aMethods[1]="" FOR EACH oItem IN THIS.pf1.pgmethods.olemethods.ListItems IF oItem.Checked IF !EMPTY(.aMethods[1]) DIMENSION .aMethods[ALEN(.aMethods)+1] ENDIF .aMethods[ALEN(.aMethods)] = oItem.Key ENDIF ENDFOR .SavePrefs() ENDWITH ENDIF ENDPROC PROCEDURE checkpaths IF ATC(" ",JUSTSTEM(ALLTRIM(THIS.pf1.pgOptions.txtWSDLFile.Value)))#0 OR; ATC(" ",JUSTSTEM(ALLTRIM(THIS.pf1.pgOptions.cboWSDLFile.DisplayValue)))#0 MESSAGEBOX(MB_URLWITHSPACE_LOC) RETURN .F. ENDIF ENDPROC PROCEDURE Init LPARAMETERS oWebRef * restore settings LOCAL i, lcWSDLFile, lcURI, lFound, lcFileLoc, loItem, lnCount DIMENSION THIS.aURIs[1,2] STORE "" TO lcWSDLFile IF VARTYPE(oWebRef) = "O" THIS.Left = oWebRef.Parent.Left + 10 THIS.Top = oWebRef.Parent.Top + 10 THIS.oWebParm = oWebRef WITH oWebRef THIS.lblCOMFile.Caption = .cCOMFile + " (" + .cClass + ")" lcWSDLFile = JUSTFNAME(.cWSDLfile) lcURI = JUSTPATH(.cWSDLListener) lcURI = IIF(RIGHT(lcURI,1)="/", lcURI, lcURI+"/") lcFileLoc = JUSTPATH(.cWSDLfile) * Main options THIS.pf1.pgOptions.txtName.Value = JUSTSTEM(.cWSDLfile) THIS.pf1.pgOptions.txtWSDLFile.Value = ADDBS(JUSTPATH(.cWSDLfile)) THIS.pf1.pgOptions.cboWSDLFile.AddItem(lcURI) THIS.pf1.pgOptions.cboWSDLFile.DisplayValue = lcURI THIS.pf1.pgOptions.opgListener.Value = IIF(.lUseIsapi,1,2) THIS.pf1.pgOptions.txtAppName.Value = .cAppName THIS.pf1.pgOptions.chkPHook.Enabled = !EMPTY(.cProject) THIS.pf1.pgOptions.chkPHook.Value = .lUsePHook THIS.pf1.pgOptions.chkUnicode.Value = .lUnicode THIS.pf1.pgOptions.opgScript.Value = IIF(.lUseJScript,2,1) * Namespace options THIS.pf1.pguRIs.txtWSDLURI.Value = .cURI1 THIS.pf1.pguRIs.txtSchemaURI.Value = .cURI2 THIS.pf1.pguRIs.txtMessageURI.Value = .cURI3 THIS.pf1.pguRIs.txtActionURI.Value = .cURI4 * Method options LOCAL laMethods, lnCount DIMENSION laMethods[1] lnCount = 0 THIS.oTypelib.cTypelib = .cCOMFile lnCount = THIS.oTypelib.GetMethods(@laMethods, .cClass, .F., .F., .T.) * Popupate the control here IF lnCount > 0 * Add all options here FOR i = 1 TO lnCount THIS.pf1.pgmethods.olemethods.ListItems.Add(m.i,laMethods[m.i,1],laMethods[m.i,1]) ENDFOR ENDIF IF !EMPTY(.aMethods[1]) FOR i = 1 TO ALEN(.aMethods) TRY * Need to handle change in typelib where methods added or removed loItem = THIS.pf1.pgmethods.olemethods.ListItems.Item(.aMethods[m.i]) loItem.Checked= .T. CATCH ENDTRY ENDFOR ELSE FOR i = 1 TO THIS.pf1.pgmethods.olemethods.ListItems.Count loItem = THIS.pf1.pgmethods.olemethods.ListItems.Item(m.i) loItem.Checked=.T. ENDFOR ENDIF ENDWITH ENDIF * Add local virtual dirs THIS.oWeb.GetVirDirs() IF !EMPTY(THIS.oWeb.aVirDirs) FOR i = 1 TO ALEN(THIS.oWeb.aVirDirs,1) IF UPPER(THIS.oWeb.aVirDirs[m.i,1]) == UPPER(lcURI) lFound=.T. LOOP ENDIF THIS.pf1.pgOptions.cboWSDLFile.AddItem(THIS.oWeb.aVirDirs[m.i, 1]) ENDFOR ENDIF * If location not found, let's add it. IF !lFound DIMENSION THIS.aURIs[1,2] THIS.aURIs[1,1] = lcURI THIS.aURIs[1,2] = lcFileLoc ENDIF ENDPROC PROCEDURE Refresh THIS.pf1.pgOptions.txtAppName.Enabled = (THIS.pf1.pgOptions.opgListener.Value#1) THIS.pf1.pgOptions.opgScript.SetAll("Enabled",(THIS.pf1.pgOptions.opgListener.Value#1),"OptionButton") ENDPROC  %WU%CCC JTC)Enter name to seach for in UDDI database: UDDI Search%CB TQUDDIEnv.EnvelopeQUDDI10.find_business!QUDDIEnv.RequestManagerQUDDI10.businessList     J(  &TCUDDIEnv.RequestManagerN%COB TCUDDIEnv.EnvelopeN$TCUDDI10.find_businessN#TCUDDI10.businessListNTTTdT C%C OjBT  T TC  T T T CUDDIEnv.EnvelopeN(TCUDDI10.get_serviceDetailNT TTC  T%.$TCUDDI10.serviceDetailNT!T CC T T /%CWSDL C.ASMX  !/%CWSDL C.ASMX  T C !!C "U# TCBIZNAMELCNAMELOENVLOFINDLOREQ LOBIZLIST LCBIZNAME LCBIZDESC LCSVCNAME LCSVCDESC LCACCESSPOINTLOINFOLOENV2LOENV3LOENV4LOSVCDETPLUGINNAMEMAXROWS UDDIREQUEST BUSINESSINFOS DESCRIPTIONITEMLOSVC SERVICEINFOS ADDSERVICEKEY SERVICEKEY UDDIERRNOBUSINESSSERVICELOBINDBINDINGTEMPLATES ACCESSPOINTTHISCLEANACCESSPOINTUPDATESERVICEARRAY T H0\ C,(C,TC ,/%CWSDLC.ASMX  T! C;\(C;XTC ;/%CWSDLC.ASMX T T!/%C.ASMXCWSDL )TCC.ASMX= ASMX?WSDLTC BU TCACCESSPOINT LCACCESSPOINTILCTMPSTR%CCC JTC)Enter name to seach for in UDDI database: UDDI Search%CB T!QUDDIEnv.RequestManagerQUDDIEnv.EnvelopeQUDDI10.find_serviceQUDDI10.serviceList      J(&TCUDDIEnv.RequestManagerN%COB TCUDDIEnv.EnvelopeN#TCUDDI10.find_serviceN"TCUDDI10.serviceListNTTTdT C%C OVBT  ~T  T CUDDIEnv.EnvelopeN(T CUDDI10.get_serviceDetailNT  T  T C  T %4.$T CUDDI10.serviceDetailNT  !TCC  T T/%CWSDLC.ASMX !/%CWSDLC.ASMX [TCCU TCBIZNAMELCNAMELOREQLOENVLOFIND LOSERLIST LCSVCNAME LCSVCDESC LCACCESSPOINTLOINFOLOENV2LOENV3LOENV4LOSVCDETPLUGINNAMEMAXROWS UDDIREQUEST SERVICEINFOS ADDSERVICEKEY SERVICEKEY UDDIERRNOBUSINESSSERVICE DESCRIPTIONITEMLOBINDBINDINGTEMPLATES ACCESSPOINTTHISCLEANACCESSPOINTUPDATESERVICEARRAYn(%CCB%C s%CC "C$TC$TC$TC$TC$TCU TCBIZNAME TCBIZDESC TCSVCNAME TCSVCDESC TCACCESSPOINTTHISFORMAUDDITHISBUNERRORCMETHODNLINEsearchbusiness,cleanaccesspoint searchserviceupdateservicearrayErrorO1qqAAA2bQAAA1QQAA"A"aQBAABA1AAARABB2qqAAAqAAAAA3qqAAAQbQAA1!QRAA"aQAAABA1AAARAB2qAAbaA!ABAAAA3A1F, [aP ~!*Fp) } d d W%_ U     TC]%CO%%CN C B T TC]TCC `TC H  RT %C`GB%C.VCXC9TC +a0F%CfFORMCloControl.DEClassbC C T T !$%CloControl.ParentbO!T%C GB- Ta%CكIn order to view the DataEnvironement of a Form class, the builder first needs to instantiate the class. Would you like to do this?$x)T C T  T-5 %NB sT ) C.TMPC PCDYou must first save form in order to properly read in control names.xB-) C.VCXC 2 T  +a HB ' C fFORM C  z T !@ CloTmpObject.ParentbOC fFORMSET %C   T !2  T T T T 2 +a8%CfFORMCloControl.ParentbO !TT T %CC%TC , TC TCb(;IF UPPER(loControl.&laObjs[m.i]..Class)="WSHANDLER".4THIS.GetControls(loControl.&laObjs[m.i]., lcKey) U LOCONTROL LCPARENTKEYLAPARENTLAOBJSILNOBJSLCKEY LHADERROR LOTREEVIEWOBJLNPARENT LOTMPOBJECT LCDECLASSLIB LCDECLASSTHISDEKEY BASECLASSDECLASSDECLASSLIBRARYPARENTODATAENV CLASSLIBRARY OCONTAINER PARENTKEYNODESADDNAME T +an/%CloParent.ParentbO C Z!T$TCa-6 T BUTONODELOPARENTPARENTTHISLDATAENVKEYDEKEY#TTUTHIS OCONTAINERODATAENV7C%0CUTHIS GETCONTROLS LINCLUDEDE-TTa%TTT  %C  T -TTT %  T-&CUNODE LCLASTKEYTHIS CCHECKEDKEYSELECTEDCHECKEDKEY CCONTROLNAMETEXT CCONTROLPATHFULLPATHNODESITEM LINCLUDEDELDATAENV ISINDATAENV getcontrols, isindataenv DestroyInit< NodeCheck 1RRAAAAaAAAAAAAA aAAAAAqqAaAAAAAAAAARQAqAAAA3qqAAAA32A2rr111AAA1T ev wr u ) zI E)d {PROCEDURE searchbusiness LPARAMETERS tcBizName IF VARTYPE(tcBizName)#"C" OR EMPTY(tcBizName) LOCAL lcName lcName = INPUTBOX(ENTERUDDINAME_LOC, UDDISEARCH_LOC, "") IF EMPTY(lcName) RETURN ENDIF tcBizName = lcName ENDIF LOCAL loEnv AS "UDDIEnv.Envelope" LOCAL loFind AS "UDDI10.find_business" LOCAL loReq AS "UDDIEnv.RequestManager" LOCAL loBizList AS "UDDI10.businessList" LOCAL lcBizName, lcBizDesc, lcSvcName, lcSvcDesc LOCAL lcAccessPoint, loInfo, loEnv2, loEnv3, loEnv4, loSvcDet STORE "" TO lcBizName, lcBizDesc, lcSvcName, lcSvcDesc, lcAccessPoint loReq = CREATEOBJECT("UDDIEnv.RequestManager") IF VARTYPE(loReq)#"O" RETURN ENDIF loEnv = CREATEOBJECT("UDDIEnv.Envelope") loFind = CREATEOBJECT("UDDI10.find_business") loBizList = CREATEOBJECT("UDDI10.businessList") loEnv.Plugin=loFind loFind.name = tcBizName loFind.maxRows=100 loEnv2=loReq.UDDIRequest(loEnv) IF VARTYPE(loEnv2)#"O" RETURN ENDIF loEnv2.Plugin=loBizList FOR EACH loInfo IN loBizList.businessInfos lcBizName = loInfo.name TRY lcBizDesc = loInfo.Description.Item(1).Description CATCH lcBizDesc="" ENDTRY FOR EACH loSvc IN loInfo.serviceInfos lcSvcName = loSvc.name loEnv3 = CREATEOBJECT("UDDIEnv.Envelope") loSvcDet = CREATEOBJECT("UDDI10.get_serviceDetail") loEnv3.Plugin = loSvcDet loSvcDet.AddserviceKey.serviceKey = loSvc.ServiceKey loEnv4 = loReq.UDDIRequest(loEnv3) loSvcDet = "" IF loReq.UDDIErrno # 0 LOOP ENDIF loSvcDet = CREATEOBJECT("UDDI10.serviceDetail") loEnv4.Plugin = loSvcDet TRY lcSvcDesc = loSvcDet.businessService(1).Description.Item(1).Description CATCH lcSvcDesc = "" ENDTRY FOR EACH loBind In loSvcDet.businessService(1).bindingTemplates lcAccessPoint = loBind.accessPoint.accessPoint IF ATC("WSDL", lcAccessPoint)#0 OR ATC(".ASMX", lcAccessPoint)#0 EXIT ENDIF ENDFOR IF ATC("WSDL", lcAccessPoint)#0 OR ATC(".ASMX", lcAccessPoint)#0 * Clean up WSDL reference lcAccessPoint = THIS.CleanAccessPoint(lcAccessPoint) ENDIF * Add items to array here THIS.UpdateServiceArray(lcBizName,lcBizDesc,lcSvcName,lcSvcDesc,lcAccessPoint) ENDFOR ENDFOR ENDPROC PROCEDURE cleanaccesspoint LPARAMETERS tcAccessPoint * Do some cleanup here LOCAL lcAccessPoint, i, lcTmpStr lcAccessPoint=tcAccessPoint DO CASE CASE ATC(",", lcAccessPoint)#0 FOR i = 1 TO GETWORDCOUNT(lcAccessPoint,",") lcTmpStr=GETWORDNUM(lcAccessPoint,m.i,",") IF ATC("WSDL", lcTmpStr)#0 OR ATC(".ASMX", lcTmpStr)#0 lcAccessPoint=lcTmpStr EXIT ENDIF ENDFOR CASE ATC(";", lcAccessPoint)#0 FOR i = 1 TO GETWORDCOUNT(lcAccessPoint,";") lcTmpStr=GETWORDNUM(lcAccessPoint,m.i,";") IF ATC("WSDL", lcTmpStr)#0 OR ATC(".ASMX", lcTmpStr)#0 lcAccessPoint=lcTmpStr EXIT ENDIF ENDFOR ENDCASE IF ATC(".ASMX", lcAccessPoint)#0 AND ATC("WSDL", lcAccessPoint)=0 lcAccessPoint=LEFT(lcAccessPoint, ATC(".ASMX",lcAccessPoint)) + "ASMX?WSDL" ENDIF lcAccessPoint=ALLTRIM(lcAccessPoint) RETURN lcAccessPoint ENDPROC PROCEDURE searchservice LPARAMETERS tcBizName IF VARTYPE(tcBizName)#"C" OR EMPTY(tcBizName) LOCAL lcName lcName = INPUTBOX(ENTERUDDINAME_LOC, UDDISEARCH_LOC, "") IF EMPTY(lcName) RETURN ENDIF tcBizName = lcName ENDIF LOCAL loReq AS "UDDIEnv.RequestManager" LOCAL loEnv AS "UDDIEnv.Envelope" LOCAL loFind AS "UDDI10.find_service" LOCAL loSerList AS "UDDI10.serviceList" LOCAL lcSvcName, lcSvcDesc LOCAL lcAccessPoint, loInfo, loEnv2, loEnv3, loEnv4, loSvcDet STORE "" TO lcSvcName, lcSvcDesc, lcAccessPoint loReq = CREATEOBJECT("UDDIEnv.RequestManager") IF VARTYPE(loReq)#"O" RETURN ENDIF loEnv = CREATEOBJECT("UDDIEnv.Envelope") loFind = CREATEOBJECT("UDDI10.find_service") loSerList = CREATEOBJECT("UDDI10.serviceList") loEnv.Plugin=loFind loFind.name = tcBizName loFind.maxRows=100 loEnv2=loReq.UDDIRequest(loEnv) IF VARTYPE(loEnv2) # "O" RETURN ENDIF loEnv2.Plugin=loSerList FOR EACH loInfo IN loSerList.serviceInfos lcSvcName = loInfo.name loEnv3 = CREATEOBJECT("UDDIEnv.Envelope") loSvcDet = CREATEOBJECT("UDDI10.get_serviceDetail") loEnv3.Plugin = loSvcDet loSvcDet.AddserviceKey.serviceKey = loInfo.ServiceKey loEnv4 = loReq.UDDIRequest(loEnv3) loSvcDet = "" IF loReq.UDDIErrno # 0 LOOP ENDIF loSvcDet = CREATEOBJECT("UDDI10.serviceDetail") loEnv4.Plugin = loSvcDet TRY lcSvcDesc = loSvcDet.businessService(1).Description.Item(1).Description CATCH lcSvcDesc = "" ENDTRY FOR EACH loBind In loSvcDet.businessService(1).bindingTemplates lcAccessPoint = loBind.accessPoint.accessPoint IF ATC("WSDL", lcAccessPoint)#0 OR ATC(".ASMX", lcAccessPoint)#0 EXIT ENDIF ENDFOR IF ATC("WSDL", lcAccessPoint)#0 OR ATC(".ASMX", lcAccessPoint)#0 * Clean up WSDL reference lcAccessPoint = THIS.CleanAccessPoint(lcAccessPoint) ENDIF * Add items to array here THIS.UpdateServiceArray("", "", lcSvcName,lcSvcDesc,lcAccessPoint) ENDFOR ENDPROC PROCEDURE updateservicearray LPARAMETERS tcBizName,tcBizDesc,tcSvcName,tcSvcDesc,tcAccessPoint IF ASCAN(THISFORM.aUDDI, tcAccessPoint,-1,-1, 5, 7)#0 RETURN ENDIF IF ALEN(THIS.aUDDI)<5 DIMENSION THIS.aUDDI[1,5] ENDIF IF !EMPTY(THIS.aUDDI[1,5]) DIMENSION THIS.aUDDI[ALEN(THIS.aUDDI,1)+1,5] ENDIF THIS.aUDDI[ALEN(THIS.aUDDI,1),1] = tcBizName THIS.aUDDI[ALEN(THIS.aUDDI,1),2] = tcBizDesc THIS.aUDDI[ALEN(THIS.aUDDI,1),3] = tcSvcName THIS.aUDDI[ALEN(THIS.aUDDI,1),4] = tcSvcDesc THIS.aUDDI[ALEN(THIS.aUDDI,1),5] = tcAccessPoint ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine RETURN ENDPROC * **c %&)J\'UbCTCF % 2T Change XML Web service... C T[&%CTHIS.colOperationsbO *C colOperations collectionOK~CfC!CC (C)CCCC%G#)T TaTCTCTCTCTCCCC T!aWU"THIS PFSETTINGS PGSERVICES LSTSERVICESCLEARLBLWSDLCTARGET CBOMETHODSOWEBCWSALIAS LFIRSTTIMELBLNEWWSCAPTION LOADOBJECT ACTIVEPAGE ADDOBJECTTYPE ADDLISTITEMCLASSNAMEUNIQUEID NEWITEMIDURI LISTCOUNT LISTINDEXENABLEDWSDLWSMLSERVICEPORTWSNAME UPDATESERVICELISTLWSFOUND%C gF$-CCfCCf CfC %C4 cBTCT C T C T C T CTTC Ta C(C`#CCC C C %T CULCWSITHISOWEBCWSALIASUNIQUEIDTYPEWSDLURIWSMLSERVICENAMEPORTWSNAMECLASSLBLWSDLCTARGET PFSETTINGS PGSERVICES LBLSERVICEDOCCAPTIONCOMFILE CBOMETHODSENABLEDCLEARMENUADDITEM LISTCOUNT LISTINDEX UPDATEMETHOD8 TTTTTT  T   #C ()T T-TFZ-CCfCCfCCfCCf CCfCCf CfC C' TC4T  %T C (C#CCC C C !TC 6%C `T!  C"TC  -a6  T-%C C TCThe specified Web Service does not appear to be registered on this machine. You may not be able to access all the Operation and Client options. Click the Refresh link on the Services page to register this Web Service.x(TCCSetupOperations#%C C7%CTHIS.colOperationsbO$% ($%& '(CC $*)"CC $+,)T& '( C-1*C colOperations collection.U/LCSTRITHISOOBJECTWSDLWSMLSERVICEPORTWSNAMEWSMETHODWSSYNTAX PFSETTINGS PGSERVICES LSTSERVICESADDITEM LISTINDEXENABLEDLBLWSDLCTARGETOWEBCWSALIASURINAMETYPELWSFOUND LBLREFRESHVISIBLE LBLSERVICEDOCCAPTIONCOMFILE CBOMETHODSMENU LISTCOUNTVALUE UPDATEMETHOD READMETHOD COLOPERATIONSCOUNTTHISFORM PGMETHODS LSTOPERATIONS ADDLISTITEM WSOPERATIONGETKEY NEWITEMID UPDATECLIENTS ADDOBJECT Ta TBTCCC C  colOperations6 }T  T  T  T  T  H1 C  T  C 1T C]%@ G`( '%CTHIS.colOperationsO0LPARAMETERS toObjQJ* This snippet is automatically generated by the XML Web Services Builder.<5LOCAL lcClasslib, lHadError, loError, lBuilder, loObj&lBuilder = (VARTYPE(toObj)="O")(!loObj=IIF(!lBuilder, THIS, toObj)$%CC C0 0)lcClasslib = "<>""TMlcClasslib = IIF(!lBuilder, THIS.ClassLibrary, HOME() + "FFC\_ws3Client.vcx") IF !lBuilder 4- loObj.cContainer = "<>" ENDIF TRYQJ loObj.AddProperty("colOperations", NEWOBJECT("<>", lcClasslib))( =6 * Operation: <>OH WITH loObj.colOperations.NewItem([<>])C< .wsOperation = [<>]92 .wsDesc = [<>]=6 .wsMethod = [<>]=6 .wsparmnum = <>;4 .lOffline = <>A: .nParmPrompt = <>'(C I# WITH .colParms.NewItem()MF .Parmname = [<>]MF .Parmtype = [<>]QJ .InputValue = [<>]UN .InputControl = [<>]WP .InputProperty = [<>]$%C C 3 .IsByRef = .T. ENDWITH'(C  TaYR WITH .colClients.NewItem([<>])SL .ClientName = [<>]UN .ObjectRef = [<>] XQ .BindTarget = [<>] SL .BindSource = [<>]OH .BindProp = [<>]YR .lInvokeAtStart = <>kd .lAlwaysCallWebService = <> '%CC C   OH .NodeName = [<>]'%CC C   MF .DSTable = [<>]MF .DSField = [<>]c\ .DSUseExistingCursor = <> ENDWITH ENDWITHCATCH TO loError IF !lBuilder~ THIS.DisplayError("Failed to load XML Web service operation/client data."+CHR(13)+CHR(10)+CHR(13)+CHR(10)+loError.Message) ENDIF lHadError = .T. ENDTRYRETURN !lHadErrorG`G`(&CSetupOperations T U LHADMETHODLCSTRIJ LHASCLIENTSLCCLASS LHASMETHODTHISOPERATIONCLASSOOBJECTWSDLWSMLSERVICEPORTWSNAME WEBSERVICEID COLOPERATIONSCOUNTOPERATIONCLASSLIBCOLPARMSISBYREF COLCLIENTSNODENAMEDSTABLE WRITEMETHODT(TCC T  C ( CC "CC UJLNITEM LOOPERATIONTHIS PFSETTINGS PGMETHODS LSTOPERATIONS LISTINDEX COLOPERATIONSLIST TOOLTIPTEXTWSDESC LSTCLIENTSCLEAR COLCLIENTSCOUNT ADDLISTITEM CLIENTNAMEGETKEY NEWITEMID1'CXML Web Service ErrorxU TCERRMESSAGE %C`=B%C.VCXCh B TT T +a H$ CloControl.ParentbO!' CfFORM C ( TT.!@ CloTmpObject.ParentbOC fFORMSET %C   TT.!2 TT )TCC.6 BU LAPARENTLCNAME LOTMPOBJECT LOCONTROLTHISOOBJECT BASECLASS CLASSLIBRARYNAMEPARENT4T%ON-GZ UTHISOOBJECT CSAVENOTIFY %-I C`TC +a9%CfFORMCloControl.DEClassbC  Ta!$%CloControl.ParentbO!T %EEC9This visual XML Web Service is not supported on Formsets.xTaBTC T CNotifyvGZC C ULAPARENT LOCONTROL LHASFORMSET BASECLASSPARENTTHISLRELEASE LFIRSTTIMEOOBJECT WEBSERVICEID CSAVENOTIFYOWEB CHECKWSDBF UPDATEALLFT #T C -a6$TCC C C  T%CC $TCC C C /TCC CCC \6 T%C U5TSyntax: C C C C %C :T Description: C C C C  TC C TULCSYNTAXLCDESC LCDESCPANETHISOWEBCWSALIAS PFSETTINGS PGSERVICESWSMETHOD CBOMETHODS DISPLAYVALUEENABLED LISTCOUNTTIPS LISTINDEXPREFSWSDLEDTDESCVALUE updateall, updateservice loadobjectm updateobjectm updateclients displayerror getcontainerDestroyi!setup! updatemethod#1b1a!1aAaQqqA!Q!!!!!AABA3qrBAAA#!!!!cb1A!AA3Ac1Aba1A1AAa1AAQAqa!AAAA3!"!!!!1AArqaAAAAAqqqq1rq1QqAA!Arq1Q1qAq1A!AqAqqqQQqqAbaBb1B3aa!AA3qq21AAAAAqAaAAAB3aqA2AAAAAAQAAAq32A1B!AAQAAB1(%L.,AOES}h *"M""&"&*5&|&S&(Y4)T,y)*#APROCEDURE processfile LPARAMETERS tcCOMFile LOCAL laInts, lnInts, i, lFoundFile, lcFile DIMENSION laInts[1] lnInts = THIS.oTypelib.GetClasses(@laInts,tcCOMFile) IF lnInts = 0 RETURN ENDIF * Check for file already in list FOR i = 1 TO THISFORM.cboCOMFile.ListCount IF UPPER(ALLTRIM(THISFORM.cboCOMFile.ListItem[m.i])) == UPPER(tcCOMFile) lFoundFile = .T. EXIT ENDIF ENDFOR IF !lFoundFile lcFile = IIF(LEFT(tcCOMFile,2)="\\","\","")+tcCOMFile THISFORM.cboCOMFile.AddItem(lcFile) ENDIF THISFORM.cboCOMFile.DisplayValue = tcCOMFile THIS.cboInterface.Clear() FOR i = 1 TO lnInts THIS.cboInterface.AddItem(laInts[m.i,1]) ENDFOR THIS.cboInterface.Value = THIS.cboInterface.ListItem[1] THIS.cboInterface.Enabled = lnInts > 1 THIS.oWeb.lPrefsLoaded = .F. ENDPROC PROCEDURE checkclass LOCAL lcInt lcInt = ALLTRIM(THIS.cboInterface.Value) IF EMPTY(lcInt) RETURN ENDIF THIS.imgVar.Visible = !THIS.oTypelib.CheckVariant(lcInt) THIS.oWeb.lPrefsLoaded = .F. ENDPROC PROCEDURE generatews LOCAL lcCOMFile, lcClass, i, lFound, lcResults, lcPHookMsg lcCOMFile = ALLTRIM(THIS.cboCOMFile.DisplayValue) lcClass = ALLTRIM(THIS.cboInterface.DisplayValue) IF !FILE(lcCOMFile) MESSAGEBOX(NODLL_LOC) RETURN ENDIF IF LEFT(lcCOMFile,2)="\\" MESSAGEBOX(MB_NONLOCALSVR_LOC) RETURN ENDIF IF EMPTY(lcClass) MESSAGEBOX(NOCLASS_LOC) RETURN ENDIF * Generate Web Service files IF !THIS.oWeb.Autows(lcCOMFile,lcClass) IF THIS.oWeb.lPrefsLoaded && prefs loaded but need more info (file paths) MESSAGEBOX(MB_NONDEFSVR_LOC) ENDIF RETURN ENDIF * Check for first time and file existing IF !THIS.oWeb.lPrefsExist AND ; ((FILE(THIS.oWeb.cWSDLFile) AND THIS.oWeb.lGenWSDL) OR; (FILE(THIS.oWeb.cASPFile) AND !THIS.oWeb.lUseIsapi AND THIS.oWeb.lGenAsp)) IF MESSAGEBOX(MB_WSFILESEXIST_LOC,36) = 7 RETURN ENDIF ENDIF * Ensure that the methods are all valid IF !THIS.CheckMethods() RETURN ENDIF * Check if local vdir and ISAPI mappings is valid THIS.CheckIsapi() * Generate the WSDL files here WAIT WINDOW WAIT_PUBWS_LOC NOWAIT IF !THIS.oWeb.GenWS() WAIT CLEAR RETURN ENDIF WAIT CLEAR * Add Project Hook if necessary lcPHookMsg = IIF(THIS.oWeb.lUsePHook,HASPHOOK_LOC,HASNOPHOOK_LOC) IF THIS.oWeb.lChangePHook FOR i = 1 TO _VFP.Projects.Count IF UPPER(_VFP.Projects(m.i).Name) == UPPER(THIS.oWeb.cProject) lFound=.T. EXIT ENDIF ENDFOR IF !lFound MODIFY PROJECT (THIS.oWeb.cProject) NOWAIT FOR i = 1 TO _VFP.Projects.Count IF UPPER(_VFP.Projects(m.i).Name) == UPPER(THIS.oWeb.cProject) lFound=.T. EXIT ENDIF ENDFOR ENDIF IF lFound IF THIS.oWeb.lUsePHook IF EMPTY(_VFP.Projects(m.i).ProjectHookClass) _VFP.Projects(m.i).ProjectHookLibrary = THIS.ClassLibrary _VFP.Projects(m.i).ProjectHookClass = PHOOKCLASS ELSE * Check if another hook already exists IF _VFP.Projects(m.i).ProjectHookClass # PHOOKCLASS lcPHookMsg = PHOOKCONFLICT_LOC ENDIF ENDIF ELSE IF _VFP.Projects(m.i).ProjectHookClass = PHOOKCLASS _VFP.Projects(m.i).ProjectHookClass = "" _VFP.Projects(m.i).ProjectHookLibrary = "" ENDIF ENDIF ENDIF ENDIF * Display results WITH THIS.oWeb TEXT TO lcResults NOSHOW TEXTMERGE Results of components generated: COM Server: <<.cCOMFile>> Class: <<.cClass>> Generated WSDL: <> WSDL: <<.cWSDLFile>> Use ISAPI Listener: <> ASP (if not ISAPI): <<.cASPListener>> Registered: <> <> ENDTEXT ENDWITH MESSAGEBOX(lcResults,64,MBTITLE_WSGEN_LOC) THISFORM.Release() ENDPROC PROCEDURE savepos * Save positions LOCAL laProps,lnPos,lnLines,lcPropStr,i DIMENSION laProps[1] IF ATC(FOXWSDBF,DBF())=0 RETURN ENDIF LOCATE FOR UPPER(type) = "V" IF !FOUND() RETURN ENDIF laProps="" lnLines=ALINES(laProps,ALLTRIM(wsdl)) lnPos = ASCAN(laProps,"top =",-1,-1,-1,5) IF lnPos#0 laProps[lnPos]="top = "+TRANSFORM(THISFORM.top) ELSE DIMENSION laProps[ALEN(laProps)+1] laProps[ALEN(laProps)]="top = "+TRANSFORM(THISFORM.top) ENDIF lnPos = ASCAN(laProps,"left =",-1,-1,-1,5) IF lnPos#0 laProps[lnPos]="left = "+TRANSFORM(THISFORM.left) ELSE DIMENSION laProps[ALEN(laProps)+1] laProps[ALEN(laProps)]="left = "+TRANSFORM(THISFORM.left) ENDIF lcPropStr="" FOR i = 1 TO ALEN(laProps) lcPropStr = lcPropStr + laProps[m.i] +CHR(13) ENDFOR REPLACE Wsdl WITH lcPropStr ENDPROC PROCEDURE loadpos * Get Screen Settings LOCAL lnTop, lnLeft, laProps, lnPos DIMENSION laProps[1] IF ATC(FOXWSDBF,DBF())=0 RETURN ENDIF LOCATE FOR UPPER(type) = "V" IF FOUND() IF ALINES(laProps,ALLTRIM(wsdl)) > 0 lnTop = 10 lnLeft = 10 lnPos = ASCAN(laProps,"top =",-1,-1,-1,5) IF lnPos>0 lnTop = VAL(STREXTRACT(laProps[lnPos],"top =","",1,1)) ENDIF lnPos = ASCAN(laProps,"left =",-1,-1,-1,5) IF lnPos>0 lnLeft = VAL(STREXTRACT(laProps[lnPos],"left =","",1,1)) ENDIF THIS.Top = lnTop THIS.Left = lnLeft ENDIF ENDIF ENDPROC PROCEDURE checkiis LOCAL oShell, nVersion oShell = CREATEOBJECT("WScript.Shell") THIS.lSkiperror=.T. nVersion = oShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\w3svc\Parameters\MajorVersion") THIS.lSkiperror=.F. IF THIS.lHaderror OR nVersion<5 MESSAGEBOX(MB_BADIIS_LOC) RETURN .F. ENDIF ENDPROC PROCEDURE checkmethods * Check that all methods are valid LOCAL laMethods, lnCount, laTmpArray, i, lcCOMFile, lcClass, lHadProblem lcCOMFile = ALLTRIM(THIS.cboCOMFile.DisplayValue) lcClass = ALLTRIM(THIS.cboInterface.DisplayValue) DIMENSION laMethods[1] DIMENSION laTmpArray[1] lnCount = 0 THIS.oTypelib.cTypelib = lcCOMFile lnCount = THIS.oTypelib.GetMethods(@laMethods, lcClass, .F., .F., .T.) WITH THIS.oWeb ACOPY(THIS.oWeb.aMethods, laTmpArray) DIMENSION .aMethods[1] .aMethods[1]="" FOR i = 1 TO ALEN(laTmpArray) IF ASCAN(laMethods, laTmpArray[m.i],-1,-1,-1,7)#0 IF !EMPTY(.aMethods[1]) DIMENSION .aMethods[ALEN(.aMethods)+1] ENDIF .aMethods[ALEN(.aMethods)] = laTmpArray[m.i] ELSE lHadProblem=.T. ENDIF ENDFOR ENDWITH IF lHadProblem THIS.oWeb.Saveprefs() ENDIF IF EMPTY(THIS.oWeb.aMethods[1]) MESSAGEBOX(MB_ERRNOMETHODS_LOC) RETURN .F. ENDIF ENDPROC PROCEDURE checkisapi * Check to see if user has valid script mappings -- only for local vdirs. LOCAL lcChild, lcVirDir IF !THIS.oWeb.lUseIsapi RETURN ENDIF lcChild = JUSTPATH(THIS.oWeb.cWSDLListener) lcChild = ALLTRIM(SUBSTRC(lcChild, ATC("//", lcChild)+2)) lcChild = IIF(RIGHT(lcChild,1)="/", LEFT(lcChild, LEN(lcChild)-1), lcChild) lcChild = IIF(ATC("/", lcChild)=0, "", SUBSTRC(lcChild, ATC("/", lcChild))) lcVirDir = "IIS://LocalHost/w3svc/1/Root" + lcChild THIS.oWeb.Checkvdirmap(lcVirDir) ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.lHaderror=.T. IF THIS.lSkiperror=.T. RETURN ENDIF ENDPROC PROCEDURE Init LOCAL lcCOMFiles, laFiles, lnCount, i, lcFile, lcURI, loConfig IF !THIS.CheckIIS() RETURN .F. ENDIF DIMENSION laFiles[1] lcURI="" * Check if first time and prompt to configure default location (VirDir) THIS.oWeb.GetPrefs("URI",@lcURI) IF THIS.oWeb.lHadError RETURN .F. ENDIF IF EMPTY(ALLTRIM(lcURI)) MESSAGEBOX(FIRSTTIME_LOC+FIRSTTIME2_LOC,0,MBCONFIGTITLE_LOC) loConfig = NEWOBJECT("wsconfig",THIS.ClassLibrary) loConfig.lDefaultMode = .T. loConfig.Show() ENDIF * Get recently published files IF THIS.oWeb.GetPrefs("COMFILE",@lcCOMFiles) lnCount = ALINES(laFiles, lcCOMFiles) FOR i = 1 TO lnCount lcFile = ALLTRIM(laFiles[m.i]) IF FILE(lcFile) lcFile = IIF(LEFT(lcFile,2)="\\","\","")+lcFile THIS.cboCOMFile.AddItem(lcFile) ENDIF ENDFOR ENDIF * Check for open project, else use first item (most recent) FOR i = 1 TO _VFP.Projects.Count * Skip if no OLEPUBLICS IF _VFP.Projects[m.i].Servers.Count = 0 LOOP ENDIF * Check if file exists and already added lcFile = FORCEEXT(LOWER(_VFP.Projects[m.i].Name),"dll") IF !FILE(lcFile) lcFile = FORCEEXT(lcFile,"exe") IF !FILE(lcFile) LOOP ENDIF ENDIF IF ASCAN(laFiles,lcFile,-1,-1,-1,7)#0 LOOP ENDIF * Add it lcFile = IIF(LEFT(lcFile,2)="\\","\","")+lcFile THIS.cboCOMFile.AddItem(lcFile) ENDFOR * Get default file to display lcFile = "" IF THIS.cboCOMFile.ListCount > 0 IF TYPE("_VFP.ActiveProject") = "O" AND _VFP.ActiveProject.Servers.Count#0 lcFile = FORCEEXT(LOWER(_VFP.ActiveProject.Name),"dll") IF !FILE(lcFile) lcFile = FORCEEXT(lcFile,"exe") IF !FILE(lcFile) lcFile="" ENDIF ENDIF ENDIF IF EMPTY(lcFile) lcFile = THIS.cboCOMFile.ListItem[1] ENDIF THIS.cboCOMFile.DisplayValue = lcFile THISFORM.ProcessFile(ALLTRIM(lcFile)) ENDIF * Reset Screen Pos THIS.Loadpos() ENDPROC PROCEDURE Release THIS.SavePos() ENDPROC w ^^ %eU TTCCC.\ TC(TC TCC.. %C C  T! BCULCLINEILCMETHODLCTIPATMPLNLINESLCEXPRTIPS T %CCbTCTC( TTC TC%CC (TCCC C C \%C {TTT BU AMETHSILCMETHODLNCOUNTATMPLNLINESLCDESCPREFSMENU #TC RT V% p B  H CC fWSTCCustomN%TCwspicker C2%CloParm.cRetvaluebC CC  BTC%COW B%%CloParm.lUseCustombLT(%CloParm.lAddErrorCodebLTTC%C  \ {BACKSPACE} B .G%C  O B TC%C(.(T C (T C +TCQffc\graphics\method.bmpT L (%C  ~ BTC %C TT T( CXML Web ServiceB"XML Web Service" BUOFOXCODE LNMETHODS LAMETHODSLCTIP LCTRIGGER LOWSPICKERLOPARM LCGENCODELOPROXYFULLLINE VALUETYPELOCATION USERTYPEDABBREVTHIS CLASSLIBRARYSHOW CRETVALUEGETPROXYOBJECTLCUSTOMCLIENTCODE LUSECUSTOM LADDERRORCODE GETPROXYCODE GETSERVICE GETMETHODSITEMSIICONGETTIPVALUETIPMENUITEM CxU TCMESSAGEU       H]4 ."T><(:;,?/[-+*&^%$#@!.=TCTCC C>QTCTCC (%TC.TCC.24B- TC] FOXTOOLS.FLL%C0 oB-Gb( TCC CT CC C 'T *__VFPWSDef__:  = "T C % XB-T CC C >\T CC ,TCC ,TCC ,8-C  C C CfC %C4  %CbThe XML Web service you are trying to access is not registered. Would you like to register it now? If you are unable to register this service, you can prevent this prompt by renaming the object reference in its "__VFPWSDef__" reference above.$xB-%C a ~@C-Error retrieving XML Web service description.B-8-C  C C CfC %C4 B-U LCUSERTYPED LCTRIGGERLCOPS LNWORDCOUNT LCLASTWORDLAENVLNWINHDL LCFXTOOLLIBLALINESLCSTR LCSEARCHEXPRLNPOSLCWSINFOLCURI LCSERVICELCPORT_WONTOP_WSELECT _EDGETENV _EDGETSTRURINAMEPORTTYPETHISOWEB ADDFOXCODEALERT&%CC CC =TWSProxy&%CC CC zTUTHISCPROXYGENCLASSCPROXYGENCLASSLIB CLASSLIBRARY %CCCC 7 B F-CC %C4 p BTa CTCT-%CO B BU TCWSIDLOPROXYTHISCWSALIASUNIQUEID LSKIPERROR GETPROXYCLASSCPROXYGENCLASSCPROXYGENCLASSLIBF TC] FOXTOOLS.FLL%C0 RB-Gb( TCC CTCC TloWS T +a6 %CLOCAL  !TloWSC_T BU LCFXTOOLLIBLNWINHDLLCSTRLAENVLCVARLNCOUNT_WONTOP_WSELECT _EDGETENV _EDGETSTRTa%1B TCE%QT ;Make sure your FOXWS3.DBF web services table is not opened.CUNERRORCMETHODNLINETHIS LHADERROR LSKIPERROR LCMESSAGE ERRORALERTH#%C CW 4 FQ FUTHISCWSALIAS NSAVEAREATCW%TC _webservices%COSB-%C sB-TC]UTHIS NSAVEAREAOWEB CLASSLIBRARY CHECKWSDBFCWSALIASgettip, getmethodshmain= erroralertabout getservice getproxyclassgetproxyobjecte getnextvarError^DestroypInit1qQqAAAA3qQQAqA1A1AA3r1RBAdQ!AsQAR1A1AAA"AQaqAA"AqAB3q35s1!!Q!AqAqA!v!qAqAqAqAA3gqAa1A3qrA!AQA3qA!AAqA2AAqA31AA3QqAQqAa2*/~ .e h ^i%A&D#+)^ f%s6U%CO TCTC *TCCR//6T .wsdlT .asp-T CC .wsdl,TCC .aspTCTTT1% T TaTCTCT C!T"C#$T$%&'(%%)%CC$ $C$T$C$%* C+U,LCURITHISOWEBPARMCSERVICEPF1 PGOPTIONSTXTNAMEVALUE CBOWSDLFILE DISPLAYVALUE CWSDLLISTENER CASPLISTENER CWSDLFILE TXTWSDLFILECASPFILECAPPNAME TXTAPPNAME LUSEISAPI OPGLISTENER LUSEJSCRIPT OPGSCRIPTLUNICODE CHKUNICODECHKPHOOKENABLED LUSEPHOOK LCHANGEPHOOKCURI1PGURIS TXTWSDLURICURI2 TXTSCHEMAURICURI3 TXTMESSAGEURICURI4 TXTACTIONURIAMETHODSOITEM PGMETHODS OLEMETHODS LISTITEMSCHECKEDKEY SAVEPREFSJ%C CCָC CCָ C|The WSDL location contains a space which is not currently supported in URLs by the Visual FoxPro XML Web Service extensions.xB-UTHISPF1 PGOPTIONS TXTWSDLFILEVALUE CBOWSDLFILE DISPLAYVALUE  J(%COlT   T   T  h$T ()TCTC*TCCR//6TCTC TCCCT(TC6TT !C" T #T$%(T&C'6T()*T(+,T(-.T(/0 1 1 TT23TC1--a24%(|9C C 1C 15678%CC9 (C9(TCC 9567:T;ad&(567<`#TC 567:T;aC=>%C=? "(C=?%%CC =?fCf Ta.)CC =?% } T T U@OWEBREFI LCWSDLFILELCURILFOUND LCFILELOCLOITEMLNCOUNTTHISAURISLEFTPARENTTOPOWEBPARM LBLCOMFILECAPTIONCCOMFILECCLASS CWSDLFILE CWSDLLISTENERPF1 PGOPTIONSTXTNAMEVALUE TXTWSDLFILE CBOWSDLFILEADDITEM DISPLAYVALUE OPGLISTENER LUSEISAPI TXTAPPNAMECAPPNAMECHKPHOOKENABLEDCPROJECT LUSEPHOOK CHKUNICODELUNICODE OPGSCRIPT LUSEJSCRIPTPGURIS TXTWSDLURICURI1 TXTSCHEMAURICURI2 TXTMESSAGEURICURI3 TXTACTIONURICURI4 LAMETHODSOTYPELIBCTYPELIB GETMETHODS PGMETHODS OLEMETHODS LISTITEMSADDAMETHODSITEMCHECKEDCOUNTOWEB GETVIRDIRSAVIRDIRSp*TCCEnabled OptionButtonU THISPF1 PGOPTIONS TXTAPPNAMEENABLED OPGLISTENERVALUE OPGSCRIPTSETALL updatesets, checkpaths Init5Refresh)1qAAQQAAAAA2qA3qaQAArAASAAa1AAAAa!QAAAAaA312%(*Q0po))^ EE%9ZU TaUNERRORCMETHODNLINETHIS LHADERROR% B %CB"TC _webservices%COB TCCM FOXWS3.DBF%C0 B TCWF Q%CC FB-7~C'  CfP CC fC f d%CC C  ` C Q T FdR,TXML Web Service component was successfully rebuilt and supporting files regenerated.UNERRORTHIS NBUILDACTIONLOWS LNSAVEAREA CLASSLIBRARY LCVFPWSDBFUSEPHOOKTYPECOMFILE COUTPUTNAMEAUTOWSCLASSGENWSM% ,BTT#QCOMAdmin.COMAdminCatalog(TCCOMAdmin.COMAdminCatalogNC%%C C C TC $3T&IIS Out-Of-Process Pooled ApplicationsC C U COUTPUTNAME NBUILDACTION LREBUILDALL LSHOWERRORSLBUILDNEWGUIDSTHISLCAPPLOCATCONNECT CCOMPLUSAPPSHUTDOWNAPPLICATIONSTARTAPPLICATIONTCUTHIS PROJECTNAME ACTIVEPROJECTNAMEError, AfterBuildy BeforeBuildInit13qCAACA#QAAAAqAsABBA3qAAs1Q!1A3Q2Ij%l67O)ESPROCEDURE setupws LPARAMETERS tcServiceID, tcMethod LOCAL loException, lcErrorMsg, loWSHandler, lcSyntax, laParms LOCAL lcMethod, lcParms, lHadError, lnPos, laTips, leRetVal, loParmForm ,i, lcByRefChar LOCAL lHasDataSet, lctempstr, lHasHTML, lcTmpFile, lcRetVal LOCAL lnCount, laPEMs, loNode IF PCOUNT()<2 OR VARTYPE(tcServiceID)#"C" OR VARTYPE(tcMethod)#"C" RETURN ENDIF THIS.cServiceID = tcServiceID THIS.cMethod = tcMethod THIS.oWeb.CheckWSDbf() SELECT (THIS.oWeb.cWSAlias) IF EMPTY(ALIAS()) MESSAGEBOX(MB_FILEINUSE_LOC) RETURN ENDIF LOCATE FOR UniqueID=tcServiceID IF !FOUND() RETURN ENDIF lcMethod=ALLTRIM(tcMethod) THIS.lblWS.Caption=ALLTRIM(Name) DIMENSION laTips[1] ALINES(laTips, Tips, .T., CHR(13)+CHR(10)) lnPos = ASCAN(laTips, lcMethod+"(",-1,-1,-1,5) IF lnPos=0 RETURN ENDIF lcSyntax = laTips[lnPos] * Get parameters here THIS.colparms.wsSyntax=lcSyntax THIS.colparms.genParms() THIS.lblMethod.Caption=lcSyntax THIS.lbLWSDL.ctarget=ALLTRIM(Uri) IF ATC(".ASMX", Uri)#0 THIS.lblWebTest.Visible = .T. THIS.lblWebTest.Enabled = .T. THIS.lblWebTest.ctarget=SUBSTR(THIS.lbLWSDL.ctarget,1,ATC("?",THIS.lbLWSDL.ctarget)-1) ENDIF lcParms = "" IF THIS.colParms.Count>0 loParmForm = NEWOBJECT("wsParms",HOME()+"FFC\_ws3client.vcx") loParmForm.oColParms = THIS.colParms loParmForm.SetupWS() loParmForm.Show(1) ENDIF * Get Parameters lcParms = "" IF THIS.colParms.Count>0 * Need to create string here... DIMENSION laParms[THIS.colParms.Count] FOR i = 1 TO THIS.colParms.Count laParms[m.i] = "" lcByRefChar="" TRY laParms[m.i] = THIS.colParms.GetParm(m.i) lcByRefChar=IIF(THIS.colParms.Item[m.i].IsByRef,"@","") CATCH TO loException ENDTRY lcParms = lcParms + lcByRefChar + "laParms[" + TRANSFORM(m.i) + "]" IF m.i < THIS.colParms.Count lcParms = lcParms + "," ENDIF ENDFOR ENDIF lcMethod = lcMethod + "(" + lcParms +")" TRY loWSHandler = NEWOBJECT("WSHandler",IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_ws3client.vcx") IF EMPTY(ALLTRIM(wsml)) loWSfox1 = loWSHandler.SetupClient(ALLTRIM(Uri), ALLTRIM(Name) ,ALLTRIM(Port)) ELSE loWSfox1 = loWSHandler.SetupClient(ALLTRIM(Uri), ALLTRIM(Name) ,ALLTRIM(Port), ALLTRIM(wsml)) ENDIF leRetVal = loWSfox1.&lcMethod. CATCH TO loException lHadError=.T. lcErrorMsg="Error: "+TRANSFORM(loException.Errorno)+" - "+loException.Message DO CASE CASE VARTYPE(loWSfox1)#"O" * Handle SOAP error connecting to web service IF !EMPTY(loWSHandler.SoapErrorString) lcErrorMsg=MB_NOWS_LOC + CRLF + CRLF + loWSHandler.SoapErrorDetail ENDIF CASE !EMPTY(loWSfox1.FaultCode) * Handle SOAP error calling method lcErrorMsg=lcErrorMsg+CHR(13)+loWSfox1.Detail OTHERWISE * Handle other error ENDCASE ENDTRY THIS.ReturnValue = leRetVal IF !lHadError * Populate byref return values in colParms collection FOR i = 1 TO THIS.colParms.Count TRY IF THIS.colParms.Item[m.i].IsByRef THIS.colParms.Item[m.i].AddProperty("ReturnValue", laParms[m.i]) ENDIF CATCH ENDTRY ENDFOR ENDIF * Handle various types DO CASE CASE lHadError lcRetVal = lcErrorMsg CASE VARTYPE(leRetVal)="C" lcRetVal = ALLTRIM(leRetVal) IF LEFT(lcRetVal,1)="<" lcRetVal = ALLTRIM(STRCONV(lcRetVal,9)) ENDIF CASE VARTYPE(leRetVal)#"O" lcRetVal = TRANSFORM(leRetVal) CASE TYPE("leRetVal.length")="N" &&complex XMLDOMNode object types lcRetVal="MB_NODISPLAY_LOC" IF leRetVal.length>0 lHasDataSet = (ATC("IsDataSet",STRCONV(leRetval.item(0).xml,9))#0) IF lHasDataSet THIS.lDataset = .T. TEXT TO lctempstr NOSHOW TEXT PRETEXT 2 <> <> ENDTEXT lcRetVal = lctempstr ELSE loNode = leRetVal.item(0).parentNode IF VARTYPE(loNode)#"O" loNode = leRetVal.item(0).ownerDocument lcRetVal = loNode.xml ELSE lcRetVal = [] lcRetVal = lcRetVal + loNode.xml ENDIF ENDIF ENDIF OTHERWISE * Assume its a COM Object lcRetVal="" SET TEXTMERGE ON NOSHOW SET TEXTMERGE TO MEMVAR lcRetVal ADDITIVE \Object Members \ DIMENSION laPEMs[1] lnCount = AMEMBERS(laPEMs,leRetVal,3) lcLastPem = "" FOR i = 1 TO lnCount IF lcLastPem == laPEMs[m.i, 1] LOOP ENDIF \<>: TRY lcValue = TRANSFORM(leRetVal.&laPEMs[m.i,1]) \\ <> CATCH ENDTRY lcLastPem = laPEMs[m.i, 1] ENDFOR SET TEXTMERGE TO SET TEXTMERGE OFF ENDCASE * Choose which control to display with. lHasHTML = (ALLTRIM(LEFT(STRTRAN(lcRetval,CHR(9),""),1))="<") THIS.edtResults.Visible = !lHasHTML THIS.oleBrowser.Visible = lHasHTML TRY IF lHasHTML SET SAFETY OFF lcTmpFile = HOME()+TEST_TMP_FILE STRTOFILE(lcRetVal, lcTmpFile) && some may need optional 3rd parm of 4 THIS.oleBrowser.Object.Navigate2(lcTmpFile) THIS.xmlfile = lcTmpFile THIS.lDataSet = lHasDataSet THIS.lblBrowse.Enabled = .T. ELSE THIS.edtResults.Value = lcRetVal THIS.lblBrowse.Visible = .F. ENDIF CATCH TO loError ENDTRY ENDPROC PROCEDURE Destroy IF VARTYPE(THIS.cFormref)="C" AND !EMPTY(THIS.cFormref) RELEASE (THIS.cFormref) ENDIF ENDPROC PROCEDURE Resize THIS._RESIZABLE1.AdjustControls() ENDPROC ,_PROCEDURE updateall * Reset defaults THIS.pfSettings.pgServices.lstServices.Clear() THIS.lblWSDL.cTarget = "" THIS.pfSettings.pgServices.cboMethods.Clear() SELECT (THIS.oWeb.cWSAlias) * Builder comes in reentrant IF !THIS.lFirsttime THIS.pfSettings.pgServices.lblNewWS.Caption = CHANGEWS_LOC THIS.LoadObject() THIS.pfSettings.ActivePage=2 ELSE IF TYPE("THIS.colOperations")#"O" THIS.AddObject("colOperations","collection") ENDIF TRY WITH THIS.pfSettings.pgServices.lstServices SCAN FOR UPPER(Type)="C" .AddListItem(ALLTRIM(Class) + " (" + ALLTRIM(Name) + ")") .AddListItem(ALLTRIM(UniqueID), .NewItemId, 2) .AddListItem(ALLTRIM(URI), .NewItemId, 3) ENDSCAN IF .ListCount>0 GO TOP .ListIndex = 1 .Enabled = .T. THIS.WSDL = ALLTRIM(Uri) THIS.WSML = ALLTRIM(Wsml) THIS.Service = ALLTRIM(Name) THIS.Port = ALLTRIM(Port) THIS.wsname = ALLTRIM(Class) THIS.UpdateService(ALLTRIM(.List(1,2))) THIS.lWSfound = .T. ENDIF ENDWITH CATCH ENDTRY ENDIF ENDPROC PROCEDURE updateservice LPARAMETERS lcWS LOCAL i IF !EMPTY(lcWS) SELECT (THIS.oWeb.cWSalias) LOCATE FOR UPPER(ALLTRIM(UniqueID)) == UPPER(ALLTRIM(lcWS)) AND; UPPER(Type) = "C" IF !FOUND() RETURN ENDIF ENDIF * Set properties THIS.WSDL = ALLTRIM(Uri) THIS.WSML = ALLTRIM(Wsml) THIS.Service = ALLTRIM(Name) THIS.Port = ALLTRIM(Port) THIS.wsName = ALLTRIM(Class) * Set controls THIS.lblWSDL.ctarget = THIS.WSDL THIS.pfSettings.pgServices.lblServiceDoc.Caption = ALLTRIM(Comfile) WITH THIS.pfSettings.pgServices.cboMethods .Enabled=.T. .Clear() FOR i = 1 TO GETWORDCOUNT(Menu) .AddItem(ALLTRIM(GETWORDNUM(Menu, m.i, CHR(13)+CHR(10)))) ENDFOR IF .ListCount>0 .ListIndex=1 ENDIF ENDWITH THIS.UpdateMethod() ENDPROC PROCEDURE loadobject LOCAL lcStr,i * Load property settings WITH THIS.oObject THIS.WSDL = .WSDL THIS.WSML = .WSML THIS.Service = .Service THIS.Port = .Port THIS.wsname = .wsname THIS.wsmethod = .wsmethod THIS.wssyntax = .wssyntax ENDWITH * Set various builder controls WITH THIS.pfSettings.pgServices.lstServices .AddItem(THIS.wsname + " (" + THIS.Service + ")") .ListIndex=1 .Enabled=.F. ENDWITH THIS.lblWSDL.cTarget = THIS.WSDL * See if we have web service registered SELECT (THIS.oWeb.cWSAlias) LOCATE FOR UPPER(ALLTRIM(URI)) == UPPER(ALLTRIM(THIS.WSDL)) AND ; UPPER(ALLTRIM(Name)) == UPPER(ALLTRIM(THIS.Service)) AND ; UPPER(ALLTRIM(Port)) == UPPER(ALLTRIM(THIS.Port)) AND ; UPPER(Type) = "C" AND !DELETE() THIS.lwsfound = FOUND() THIS.pfSettings.PgServices.lblRefresh.Visible = !THIS.lwsfound IF THIS.lwsFound THIS.pfSettings.pgServices.lblServiceDoc.Caption = ALLTRIM(Comfile) WITH THIS.pfSettings.pgServices.cboMethods FOR i = 1 TO GETWORDCOUNT(Menu) .AddItem(ALLTRIM(GETWORDNUM(Menu,m.i,CHR(13)+CHR(10)))) ENDFOR .ListIndex=IIF(.ListCount>0,1,0) IF !EMPTY(THIS.wsMethod) .Value=THIS.wsMethod ENDIF THIS.UpdateMethod() .Enabled=IIF(.ListCount<2, .F., .T.) ENDWITH ELSE WITH THIS.pfSettings.pgServices.cboMethods .Enabled=.F. IF !EMPTY(THIS.wsMethod) .AddItem(THIS.wsMethod) .ListIndex=1 ENDIF ENDWITH MESSAGEBOX(REREGSITERWS_LOC) ENDIF lcStr = ALLTRIM(THIS.oObject.ReadMethod("SetupOperations")) IF !EMPTY(lcStr) EXECSCRIPT(lcStr,THIS) IF TYPE("THIS.colOperations")="O" AND THIS.ColOperations.Count>0 * Popupate the Operations collection FOR i = 1 TO THIS.ColOperations.Count WITH THISFORM.pfSettings.pgMethods.lstOperations .AddListItem(THIS.ColOperations(m.i).wsOperation) .AddListItem(THIS.ColOperations.GetKey(m.i), .NewItemId, 2) ENDWITH ENDFOR THISFORM.pfSettings.pgMethods.lstOperations.ListIndex=1 THIS.UpdateClients() ENDIF ELSE THIS.AddObject("colOperations","collection") ENDIF ENDPROC PROCEDURE updateobject * Set object properties LOCAL lHadMethod, lcStr, i, j, lHasClients, lcClass lHasMethod = .T. lcStr="" lcClass=IIF(VARTYPE(THIS.OperationClass)#"C" OR EMPTY(THIS.OperationClass), "colOperations", THIS.OperationClass) WITH THIS .oobject.WSDL = .WSDL .oobject.WSML = .WSML .oobject.Service = .Service .oobject.Port = .Port .oobject.wsname = .wsname DO CASE CASE EMPTY(.WSDL) .oobject.WebServiceID = "" CASE EMPTY(.oobject.WebServiceID) .oobject.WebServiceID = SYS(2015) ENDCASE IF THIS.colOperations.Count>0 SET TEXTMERGE ON TO MEMVAR lcStr NOSHOW IF VARTYPE("THIS.colOperations")#"O" \LPARAMETERS toObj \* This snippet is automatically generated by the XML Web Services Builder. \LOCAL lcClasslib, lHadError, loError, lBuilder, loObj \lBuilder = (VARTYPE(toObj)="O") \loObj=IIF(!lBuilder, THIS, toObj) IF VARTYPE(THIS.OperationClasslib)="C" AND FILE(THIS.OperationClasslib) \lcClasslib = "<>" ELSE \lcClasslib = IIF(!lBuilder, THIS.ClassLibrary, HOME() + "FFC\_ws3Client.vcx") ENDIF \IF !lBuilder \ loObj.cContainer = "<>" \ENDIF \ \TRY \ \ loObj.AddProperty("colOperations", NEWOBJECT("<>", lcClasslib)) FOR i = 1 TO THIS.colOperations.Count \ \ * Operation: <> \ WITH loObj.colOperations.NewItem([<>]) \ \ .wsOperation = [<>] \ .wsDesc = [<>] \ .wsMethod = [<>] \ .wsparmnum = <> \ .lOffline = <> \ .nParmPrompt = <> FOR j = 1 TO THIS.colOperations(m.i).colParms.Count \ \ WITH .colParms.NewItem() \ .Parmname = [<>] \ .Parmtype = [<>] \ .InputValue = [<>] \ .InputControl = [<>] \ .InputProperty = [<>] IF THIS.colOperations(m.i).colParms(m.j).IsByRef \ .IsByRef = .T. ENDIF \ ENDWITH ENDFOR FOR j = 1 TO THIS.colOperations(m.i).colClients.Count lHasClients=.T. \ \ WITH .colClients.NewItem([<>]) \ .ClientName = [<>] \ .ObjectRef = [<>] \ .BindTarget = [<>] \ .BindSource = [<>] \ .BindProp = [<>] \ .lInvokeAtStart = <> \ .lAlwaysCallWebService = <> IF !EMPTY(THIS.colOperations(m.i).colClients(m.j).NodeName) \ .NodeName = [<>] ENDIF IF !EMPTY(THIS.colOperations(m.i).colClients(m.j).DSTable) \ .DSTable = [<>] \ .DSField = [<>] \ .DSUseExistingCursor = <> ENDIF \ ENDWITH ENDFOR \ \ ENDWITH ENDFOR \ \CATCH TO loError \ \ IF !lBuilder \ THIS.DisplayError(ACTIONFAIL_LOC+CRLF+CRLF+loError.Message) \ ENDIF \ lHadError = .T. \ \ENDTRY \ \RETURN !lHadError ENDIF SET TEXTMERGE OFF SET TEXTMERGE TO ENDIF THIS.oObject.WriteMethod("SetupOperations",lcStr) THIS.oObject.lHasClients=lHasClients ENDWITH ENDPROC PROCEDURE updateclients LOCAL j, lnItem, loOperation lnItem = THIS.pfSettings.pgMethods.lstOperations.ListIndex loOperation = THIS.colOperations(THIS.pfSettings.pgMethods.lstOperations.List(lnItem,2)) THIS.pfSettings.pgMethods.lstOperations.ToolTipText = loOperation.wsDesc THIS.pfSettings.pgMethods.lstClients.Clear() FOR j = 1 TO loOperation.ColClients.Count WITH THIS.pfSettings.pgMethods.lstClients .AddListItem(loOperation.ColClients(m.j).ClientName) .AddListItem(loOperation.ColClients.GetKey(m.j), .NewItemId, 2) ENDWITH ENDFOR ENDPROC PROCEDURE displayerror LPARAMETERS tcErrMessage MESSAGEBOX(tcErrMessage, 0, MB_SOAPERRTITLE_LOC) ENDPROC PROCEDURE getcontainer LOCAL laParent, lcName, loTmpObject , loControl DIMENSION laParent[1] IF ASELOBJ(laParent,3)=0 RETURN ENDIF IF ATC(".VCX", laParent[2])=0 RETURN "" ENDIF lcName = "" loControl = THIS.oobject loTmpObject = loControl DO WHILE .T. DO CASE CASE TYPE("loControl.Parent")#"O" EXIT CASE UPPER(loTmpObject.BaseClass)=="FORM" AND !EMPTY(loTmpObject.ClassLibrary) loControl = loTmpObject lcName = loControl.Name + "." + lcName EXIT CASE TYPE("loTmpObject.Parent")="O" AND UPPER(loTmpObject.Parent.BaseClass)=="FORMSET" IF !EMPTY(loTmpObject.Parent.ClassLibrary) loControl = loTmpObject lcName = loControl.Name + "." + lcName ENDIF EXIT OTHERWISE loControl = loTmpObject loTmpObject = loControl.Parent lcName = loControl.Name + IIF(EMPTY(lcName),"",".") + lcName ENDCASE ENDDO RETURN lcName ENDPROC PROCEDURE Destroy THIS.oObject="" IF THIS.cSaveNotify="ON" SET NOTIFY CURSOR ON ENDIF ENDPROC PROCEDURE setup * Check for form container (VCX only) IF .F. LOCAL laParent, loControl, lHasFormset DIMENSION laParent[1] ASELOBJ(laParent,3) loControl = laParent[1] DO WHILE .T. IF UPPER(loControl.BaseClass)=="FORM" AND TYPE("loControl.DEClass")#"C" lHasFormset=.T. EXIT ENDIF IF TYPE("loControl.Parent")#"O" EXIT ENDIF loControl=loControl.Parent ENDDO IF lHasFormset MESSAGEBOX(NOFORMSET_LOC) THIS.lrelease = .T. RETURN ENDIF ENDIF THIS.lFirsttime = EMPTY(THIS.oobject.webserviceid) THIS.cSaveNotify=SET("Notify",1) SET NOTIFY CURSOR OFF THIS.oWeb.CheckWSDbf() THIS.UpdateAll() ENDPROC PROCEDURE updatemethod LOCAL lcSyntax, lcDesc, lcDescPane SELECT (THIS.oWeb.cWSalias) WITH THIS.pfSettings.pgServices THIS.wsMethod = .cboMethods.DisplayValue .cboMethods.Enabled = IIF(.cboMethods.ListCount=0, .F., .T.) lcSyntax = ALLTRIM(GETWORDNUM(Tips, .cboMethods.ListIndex, CHR(13)+CHR(10))) lcDesc = "" IF !EMPTY(ALLTRIM(prefs)) lcDesc = ALLTRIM(GETWORDNUM(Prefs,.cboMethods.ListIndex, CHR(13)+CHR(10))) lcDesc = IIF(GETWORDCOUNT(lcDesc)<2,"",ALLTRIM(SUBSTR(lcDesc,ATC(" ", lcDesc)))) ENDIF * Update desc editbox lcDescPane = "" IF !EMPTY(lcSyntax) lcDescPane = lcDescPane + SYNTAX_LOC + lcSyntax + CRLF + CRLF ENDIF IF !EMPTY(lcDesc) lcDescPane = lcDescPane + DESCRIPT_LOC + lcDesc + CRLF + CRLF ENDIF lcDescPane = lcDescPane + THIS.WSDl + CRLF .edtDesc.Value = lcDescPane ENDWITH ENDPROC PROCEDURE setup LOCAL i, lnVirDirs, lcValue lcValue="" * Get local virtual directories IF !THIS.oWeb.GetVirDirs() THIS.opgDefaultVD.option1.Enabled = .F. THIS.opgDefaultVD.option2.Enabled = .F. THIS.lblNew.Enabled = .F. THIS.lblPath.Enabled = .F. THIS.lblDesc.Caption = LBL_NOIIS_LOC ENDIF * Add local virtual directories to combo IF !EMPTY(THIS.oWeb.aVirDirs) lnVirDirs = ALEN(THIS.oWeb.aVirDirs,1) FOR i = 1 TO lnVirDirs THIS.cboVirDir.AddItem(THIS.oWeb.aVirDirs[m.i,1]) ENDFOR THIS.cboVirDir.DisplayValue=THIS.cboVirDir.ListItem[lnVirDirs] THIS.txtPath.Value = THIS.oWeb.aVirDirs[lnVirDirs, 2] ENDIF * Get default URL if previously saved. * Note: user could have canceled out initially in which * case there is an "*" stored. THIS.oWeb.GetPrefs("Uri",@lcValue) IF !EMPTY(ALLTRIM(lcValue)) AND ATC("*", lcValue)=0 THIS.cDefURI = ALLTRIM(GETWORDNUM(lcValue,1,CHR(13))) THIS.cDefPath = ALLTRIM(GETWORDNUM(lcValue,2,CHR(13))) IF ASCAN(THIS.oWeb.aVirDirs,THIS.cDefURI)=0 THIS.cboVirDir.AddItem(THIS.cDefURI) ENDIF THIS.cboVirDir.DisplayValue = THIS.cDefURI THIS.txtPath.Value = THIS.cDefPath ENDIF ENDPROC PROCEDURE getwslocation LOCAL lcVirDir, lcName, lcPath, lcVarName, lcParent, lcChild lcPath = ALLTRIM(THISFORM.txtPath.Value) IF THISFORM.opgDefaultVD.Value = 1 lcVirDir = THISFORM.cboVirDir.DisplayValue IF EMPTY(lcVirDir) lcVirDir = THISFORM.cboVirDir.Text ENDIF IF EMPTY(lcVirDir) OR RIGHT(ALLTRIM(lcVirDir),1)#"/" OR ; (ATC("http://",lcVirDir)=0 AND ATC("https://",lcVirDir)=0) MESSAGEBOX(VD_BADPARM_LOC) RETURN .F. ENDIF ELSE lcName = ALLTRIM(THISFORM.txtNewVirDir.Value) lcVirDir = THISFORM.cboVirDir.DisplayValue + ALLTRIM(THISFORM.txtNewVirDir.Value) IF EMPTY(lcVirDir) OR EMPTY(lcPath) OR EMPTY(lcName) MESSAGEBOX(VD_BADPARM_LOC) RETURN .F. ENDIF lcChild = THISFORM.cboVirDir.DisplayValue lcChild = ALLTRIM(SUBSTRC(lcChild, ATC("//", lcChild)+2)) lcChild = IIF(RIGHT(lcChild,1)="/", LEFT(lcChild, LEN(lcChild)-1), lcChild) lcChild = IIF(ATC("/", lcChild)=0, "", SUBSTRC(lcChild, ATC("/", lcChild))) lcParent = "IIS://LocalHost/w3svc/1/Root" + lcChild IF !THISFORM.oWeb.CreateVirDir(lcName, lcPath, lcParent) * Handle problem creating New Virtual Directory MESSAGEBOX(CREATEVDERR_LOC) RETURN .F. ENDIF IF RIGHT(ALLTRIM(lcVirDir),1)#"/" lcVirDir = lcVirDir + "/" ENDIF ENDIF * Set var reference for URL location IF !EMPTY(THIS.cURLLocation) lcVarName = THIS.cURLLocation STORE lcVirDir TO &lcVarName. ENDIF * Set var reference for URL path IF !EMPTY(THIS.cURLPath) lcVarName = THIS.cURLPath STORE lcPath TO &lcVarName. ENDIF IF THIS.lDefaultMode OR THIS.chkDefault.Value * set default location IF THISFORM.oWeb.UpdatePrefs("URI",lcVirDir + CHR(13) + lcPath) WAIT WINDOW VDSUCCESS_LOC TIMEOUT 1 ENDIF ENDIF ENDPROC PROCEDURE Init LPARAMETERS tcURIVarRef, tcPathVarRef IF VARTYPE(tcURIVarRef)="C" THIS.cUrllocation = tcURIVarRef ENDIF IF VARTYPE(tcPathVarRef)="C" THIS.cUrlPath = tcPathVarRef ENDIF THIS.Setup() ENDPROC PROCEDURE Show LPARAMETERS nStyle IF THIS.ldefaultmode THIS.lblType.Caption = LBL1CAPTION2_LOC ELSE THIS.lblType.Caption = LBL1CAPTION1_LOC ENDIF THIS.chkDefault.Visible = !THIS.lDefaultmode ENDPROC PROCEDURE Refresh LOCAL lcVDir, i, lFound lcVDir = ALLTRIM(THIS.cboVirDir.DisplayValue) IF !EMPTY(THIS.cDefuri) AND lcVdir==THIS.cDefuri THIS.txtPath.Value = THIS.cDefPath lFound=.F. ELSE FOR i = 1 TO ALEN(THIS.oWeb.aVirDirs,1) IF UPPER(THIS.oWeb.aVirDirs[m.i,1])==UPPER(lcVDir) THIS.txtPath.Value = THIS.oWeb.aVirDirs[m.i,2] lFound =.T. EXIT ENDIF ENDFOR ENDIF THIS.cmdGetDir.Enabled = IIF(THIS.cboVirDir.Style=2, .T., !lFound) ENDPROC "( "" %&!-U TC%\B( $%CCC  fCf Ta!% +TCC=\\\6C T C(`CC  TC TT-U TCCOMFILELAINTSLNINTSI LFOUNDFILELCFILETHISOTYPELIB GETCLASSESTHISFORM CBOCOMFILE LISTCOUNTLISTITEMADDITEM DISPLAYVALUE CBOINTERFACECLEARVALUEENABLEDOWEB LPREFSLOADEDfTC%C/BTC T -U LCINTTHIS CBOINTERFACEVALUEIMGVARVISIBLEOTYPELIB CHECKVARIANTOWEB LPREFSLOADED!TCTC %C0 :C.You must first select a valid COM server file.xB%C=\\^CRCOM Servers on network locations are not supported. You must specify a local file.xB%CW/C#You must select a valid class name.xB%C '% CوYour specified web service location does not appear to be a local path. Click on the Advanced... button to enter this information first.xB]% FC 0   (C 0       e%CNOne or more web service files already exist. Would you like to overwrite them?$xB%C B CGR,:<Please be patient while publishing your XML Web service.....%C  R BR (TC  YesNone6% (C'%CC CfC f Ta!% / :(C'%CC CfC f Ta! %% %CC CTC !TC WSPHOOK{$%C CWSPHOOKw1T$Another project hook already exists.$%C CWSPHOOKTC TC   M(`& Results of components generated:COM Server: <<.cCOMFile>>Class: <<.cClass>>5/Generated WSDL: <>WSDL: <<.cWSDLFile>>:4Use ISAPI Listener: <>+%ASP (if not ISAPI): <<.cASPListener>>VPRegistered: <>RL <>5C@#XML Web Services Publishing Resultsx C U! LCCOMFILELCCLASSILFOUND LCRESULTS LCPHOOKMSGTHIS CBOCOMFILE DISPLAYVALUE CBOINTERFACEOWEBAUTOWS LPREFSLOADED LPREFSEXIST CWSDLFILELGENWSDLCASPFILE LUSEISAPILGENASP CHECKMETHODS CHECKISAPIGENWS LUSEPHOOK LCHANGEPHOOKPROJECTSCOUNTNAMECPROJECTPROJECTHOOKCLASSPROJECTHOOKLIBRARY CLASSLIBRARYTHISFORMRELEASE1 %C FOXWS3.DBFC&GB-CfV %C4 mB TTCC(TCtop =%"Ttop = C_1C%TCtop = C_)TCleft =%#Tleft = C _C&TCleft = C _ T(CTC C  >U LAPROPSLNPOSLNLINES LCPROPSTRITYPEWSDLTHISFORMTOPLEFT %C FOXWS3.DBFC&CB-CfV %C4%CC T T (TCtop =%(TCCCtop =g)TCleft =%a)TCCCleft =gTTU LNTOPLNLEFTLAPROPSLNPOSTYPEWSDLTHISTOPLEFT TC WScript.ShellNTafTCRHKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\w3svc\Parameters\MajorVersionT-% EC9Cannot run Wizard. You must be running IIS 5.0 or higher.xB-UOSHELLNVERSIONTHIS LSKIPERRORREGREAD LHADERRORwTC TC   TT TC--a C T(C.%CC %CC ]CTCC  Ta %C%CCpCمNo methods are specified for the selected class. Pick methods you would like to include in your Web service from the Advanced dialog.xB-U LAMETHODSLNCOUNT LATMPARRAYI LCCOMFILELCCLASS LHADPROBLEMTHIS CBOCOMFILE DISPLAYVALUE CBOINTERFACEOTYPELIBCTYPELIB GETMETHODSOWEBAMETHODS SAVEPREFS % #BTC TCCC//굛0TCCR/CC>=61TCC/CC/6-TIIS://LocalHost/w3svc/1/RootCULCCHILDLCVIRDIRTHISOWEB LUSEISAPI CWSDLLISTENER CHECKVDIRMAP:Ta%a3BUNERRORCMETHODNLINETHIS LHADERROR LSKIPERRORP%C 8B-  TCURI % B-%CCFnCٛBefore you can start publishing XML Web services, it is recommended that you set a local URL (virtual directory) to store generated XML Web service files. ّThis is a default location used to simplify publishing your XML Web Services. You will only need to set this once and can easily change it later.,Visual FoxPro XML Web Services ConfigurationxTCwsconfig T a C"%CCOMFILE TC(TCC %C0+TCC=\\\6C(C  %C CH.$TCCC C@dll%C0 TCexe%C0 .'%C.+TCC=\\\6C T%<9%C_VFP.ActiveProjectbOC TCCC@dll%C0 TCexe%C0  T%CTCTCC CU LCCOMFILESLAFILESLNCOUNTILCFILELCURILOCONFIGTHISCHECKIISOWEBGETPREFS LHADERROR CLASSLIBRARY LDEFAULTMODESHOW CBOCOMFILEADDITEMPROJECTSCOUNTSERVERSNAME LISTCOUNT ACTIVEPROJECTLISTITEM DISPLAYVALUETHISFORM PROCESSFILELOADPOS CUTHISSAVEPOS processfile, checkclass generatewsnsavepos loadposrcheckiisB checkmethods checkisapiError Init~Release1qqAAAAAAAA1qAq2qQAA3QQAAAAAA1A AAAQAAA#AAsQQAAQ1qAAA!qAAAA1BAAAAAAAaaaQaa!AAR3rAAAAq!AQA1AaAA32AAAAAA3aQqA2QQ1qAQQAAAAA qA2AAAaA2!AA3!qA2qAA#QqaAAAAAABaAAAqAAAAqaAAAqA1!A216!# ,}:Y A% A #+(#6#l)"NPROCEDURE genwsdl LOCAL loGen, loGen2, loDOM, lSuccess, lnSaveArea, lcXML lSuccess = .T. lnSaveArea = SELECT() IF !THIS.CheckWSdbf() SELECT (lnSaveArea) RETURN .F. ENDIF SELECT (THIS.cWSAlias) LOCATE FOR UPPER(TYPE)="P" AND ; UPPER(ALLTRIM(COMfile))== UPPER(THIS.cCOMFile) AND ; UPPER(ALLTRIM(Class)) == UPPER(THIS.cClass) AND !DELETED() IF !FOUND() OR EMPTY(ALLTRIM(Menu)) * Try again to save prefs THIS.Saveprefs() LOCATE FOR UPPER(TYPE)="P" AND ; UPPER(ALLTRIM(COMfile))== UPPER(THIS.cCOMFile) AND ; UPPER(ALLTRIM(Class)) == UPPER(THIS.cClass) AND !DELETED() IF !FOUND() OR EMPTY(ALLTRIM(Menu)) SELECT (lnSaveArea) RETURN .F. ENDIF ENDIF lcXML = ALLTRIM(Menu) SELECT (lnSaveArea) TRY loGen=CREATEOBJECT(WSDLGEN_CLASS) loDOM=CREATEOBJECT(MSXML4_CLASS) loDOM.LoadXML(lcXML) loGen.Init(loDOM) loGen2=GETINTERFACE(loGen) loGen2.GenerateFile(0) CATCH lSuccess = .F. FINALLY THIS.Updateprefs("COMFILE", THIS.cCOMFile, .T.) ENDTRY RETURN lSuccess ENDPROC PROCEDURE genasp LPARAMETERS tcASP, tcWSDL, tcWSML, tcAppName * Generates a listener ASP file (high-level) for web service * Parameters: * tcASP - name of ASP file * tcWSDL - name of WSDL file * tcWSML - name of WSDML file (optional - if not provided, then look for same name as WSDL) * tcAppName - name of application for ASP LOCAL lcFileStr, lcWSDL, lcWSML, lcAppName, lcSafety, lcASP * Check for valid parms IF EMPTY(tcASP) OR EMPTY(tcWSDL) THIS.Alert(INVALIDPARM_LOC) RETURN .F. ENDIF IF !FILE(tcWSDL) THIS.Alert(NOWSDLFILE_LOC) RETURN .F. ENDIF IF EMPTY(tcWSML) tcWSML = FORCEEXT(tcWSDL,"WSML") ENDIF IF !FILE(tcWSML) THIS.Alert(NOWSDLFILE_LOC) RETURN .F. ENDIF IF EMPTY(tcAppName) tcAppName = JUSTSTEM(tcWSDL)+"Server" ENDIF lcAppName = tcAppName lcASP = tcASP lcWSDL = SYS(2014,tcWSDL, lcASP) lcWSML = SYS(2014,tcWSML, lcASP) lcFileStr = IIF(THIS.lUseJScript, THIS.GetASP_JS(lcAppName, lcWSDL, lcWSML),THIS.GetASP_VBS(lcAppName, lcWSDL, lcWSML)) lcSafety = SET("SAFETY") SET SAFETY OFF STRTOFILE(lcFileStr,tcASP) SET SAFETY &lcSafety. ENDPROC PROCEDURE alert LPARAMETERS tcMessage IF _VFP.StartMode#0 OR THIS.lSkipAlerts THIS.cErrorMessage = tcMessage ELSE MESSAGEBOX(tcMessage,16) ENDIF ENDPROC PROCEDURE createvirdir LPARAMETERS tcNewVirDir, tcPath, tcParent LOCAL oServObj, VdirObj, lHadError, lcParent LOCAL laMaps, oShell, lcFile TRY lcParent = IIF(EMPTY(tcParent), "IIS://LocalHost/w3svc/1/Root", tcParent) oServObj = GetObject(lcParent) VdirObj = oServObj.Create("IIsWebVirtualDir", tcNewVirDir) VdirObj.AccessRead = .F. VdirObj.AccessScript = .T. && required VdirObj.AccessExecute = .F. && can be set to .T., but is not needed (less secure) VdirObj.AspBufferingOn= .T. VdirObj.AppIsolated = 2 * 0 - Low (IIS Process), 1 - High (Isolated), 2 - Medium (Pooled) * Using 0 is best performance, but not as secure. By setting the Application Protection to * 1 or 2, you will be running inside an instance of dllhost.exe process, which runs under * a COM+ account (usually IWAM_MACHINENAME). And any error in your server COM dll * will affect only web application related to the virtual root. Configuring the virtual directory * to work under Low isolation level will run the web service within inetinfo.exe process * running under system account. The only advantage of Low isolation level is performance. VdirObj.AspAllowSessionState = .F. VdirObj.ContentIndexed = .f. VdirObj.Put("Path", tcPath) VdirObj.AppCreate2(0) VdirObj.AppFriendlyName = tcNewVirDir VdirObj.SetInfo() * Add SOAP Toolkit 3.0 ISAPI Extension mapping laMaps = VdirObj.ScriptMaps oShell = CreateObject("WScript.Shell") lcFile = oShell.RegRead(ISAPIKEY) IF FILE(lcFile) DIMENSION laMaps[ALEN(laMaps)+1] laMaps[ALEN(laMaps)] = ".wsdl," + lcFile + ",1,GET,POST" COMARRAY(VdirObj,10) VdirObj.Put("ScriptMaps", @laMaps) VdirObj.SetInfo() ENDIF CATCH lHadError=.T. ENDTRY RETURN !lHadError ENDPROC PROCEDURE addfoxcode LPARAMETERS tcWSDL, tlRefresh, tcWSML * Registers XML Web service for consumption in VFP LOCAL i, j, lcMethodStr,lcTipsStr,lcTips2Str, lcWSMLGTM LOCAL lcWSName,lcServicePort, lcService, lcPort, lcServiceDoc LOCAL lcWSDL,lcWSML,lcID,ldDateTime,lnSaveArea, loXMLDOM, lcClass LOCAL oGen,loParts,loEnumParts,loMethod,loEnumMethods,loPort,loEnumPorts,loService,loEnumServices LOCAL lcDocStr, lcDocXPath, loNodes, lcMethodStr2, lFailXPath, lcGetType STORE 0 TO loParts,loEnumParts,loMethod,loEnumMethods,loPort,loEnumPorts,loService,loEnumServices STORE "" TO lcURI,cMethodStr,lcTipsStr STORE "" TO lcWSDL_XML, lcWSML_XML, lcWSMLGTM THIS.lISenseFailed = .F. DIMENSION THIS.aPorts[1] THIS.aPorts="" lnSaveArea = SELECT() IF EMPTY(tcWSDL) RETURN .F. ENDIF lcWSDL = tcWSDL IF EMPTY(tcWSML) lcWSML = FORCEEXT(lcWSDL,"WSML") ENDIF * Load in class using XMLDOM Object loXMLDOM = CREATEOBJECT(MSXML4_CLASS) loXMLDOM.Async = .F. IF loXMLDOM.load(lcWSML) lcWSML_XML = loXMLDOM.XML IF ATC("GenericCustomTypeMapper",lcWSML_XML)#0 lcWSMLGTM=lcWSML ENDIF ENDIF IF loXMLDOM.load(lcWSDL) lcWSDL_XML = loXMLDOM.XML * Need to use XPATH to get Documentation properties TRY loXMLDOM.setProperty("SelectionNamespaces", [xmlns:wsdl="] + loXMLDOM.documentElement.namespaceURI + ["]) CATCH lFailXPath = .T. ENDTRY ENDIF * Iterate thru all Services, Ports and Methods oGen = CREATEOBJECTEX(WSDLREADER_CLASS,"","") * Retry several times in case this is in use. THIS.lIgnoreErrors = .T. FOR i = 1 TO 3 THIS.lHaderror = .F. oGen.Load(lcWSDL,"") && should not assume that all web services have a WSML file. IF !THIS.lHadError EXIT ENDIF ENDFOR THIS.lIgnoreErrors = .F. IF THIS.lHadError THIS.lHadError = .F. RETURN .F. ENDIF * Check Web Service table IF !THIS.CheckWSdbf() SELECT (lnSaveArea) RETURN .F. ENDIF SELECT (THIS.cWSAlias) * Get Service object ogen.GetSoapServices(@loEnumServices) DO WHILE .T. loEnumServices.Next(1,@loService,1) IF VARTYPE(loService)#"O" EXIT ENDIF lcServiceDoc = "" THIS.cWSname = loService.Name lcWSName = THIS.cWSname lcServiceDoc = loService.Documentation * Add WSDL record to WS table lcID = SYS(2015) ldDateTime = DATETIME() LOCATE FOR UPPER(ALLTRIM(Name))==UPPER(ALLTRIM(lcWSName)) AND UPPER(TYPE)="W" AND; UPPER(ALLTRIM(URI))==UPPER(ALLTRIM(lcWSDL)) AND !DELETED() IF FOUND() IF tlRefresh REPLACE Name WITH lcWSName, ; URI WITH lcWSDL, ; WSDL WITH lcWSDL_XML, ; WSML WITH lcWSML_XML, ; Timestamp WITH ldDateTime, ; UniqueID WITH lcID ENDIF ELSE INSERT INTO (THIS.cWSAlias) ; (Type,Name,URI,WSDL,WSML,TimeStamp,UniqueID) ; VALUES("W",lcWSName,lcWSDL,lcWSDL_XML,lcWSML_XML,ldDateTime,lcID) ENDIF * Get ports loEnumPorts=0 loService.GetSoapPorts(@loEnumPorts) DO WHILE .T. loEnumPorts.Next(1,@loPort,1) IF VARTYPE(loPort)#"O" EXIT ENDIF lcServicePort = loPort.name * Let's get class name -- typically it is same as port name, however * with SOAP Toolkit. Note: the class name is used primarily as * friendly name for display purposes lcClass = lcServicePort DO CASE CASE ATC(".asmx?wsdl",lcWSDL)#0 AND UPPER(RIGHT(lcClass,4))="SOAP" && VS .NET service lcClass = LEFT(lcClass,LEN(lcClass)-4) CASE UPPER(RIGHT(lcClass,8))="SOAPPORT" && SOAP3 Toolkit lcClass = LEFT(lcClass,LEN(lcClass)-8) ENDCASE lcTipsStr="" lcMethodStr="" lcMethodStr2="" * Get Methods loPort.GetSoapOperations(@loEnumMethods) DO WHILE .T. STORE 0 TO loMethod,loEnumParts,loParts loEnumMethods.Next(1,@loMethod,1) IF VARTYPE(loMethod)#"O" EXIT ENDIF * Get method name IF ATC("UpdateSingleTable", loMethod.Name)#0 ENDIF lcMethodStr = lcMethodStr + loMethod.Name + CRLF * Get documentation if any (need to use XPATH since STK3 doesn't support this) lcDocStr="" TRY IF !lFailXPath lcDocXPath = "//wsdl:portType[@name='" + lcServicePort + "']/wsdl:operation[@name='" + loMethod.Name + "']/wsdl:documentation" loNodes = loXMLDOM.selectNodes(lcDocXPath) IF loNodes.Length>0 lcDocStr = loNodes.item(0).text ENDIF ENDIF CATCH ENDTRY lcMethodStr2 = lcMethodStr2 + loMethod.Name + " " + lcDocStr + CRLF loMethod.GetOperationParts(@loEnumParts) lcTips2Str = "" lcRetType = "VOID" DO WHILE .T. * Get parms loParts = 0 loEnumParts.Next(1,@loParts,1) IF VARTYPE(loParts)#"O" EXIT ENDIF * Check if parameter or return type is complex object IF EMPTY(loParts.elementType) AND TYPE("loParts.SchemaNode")="O" IF ATC(":schema", loparts.SchemaNode.xml)#0 lcGetType = "Dataset" ELSE lcGetType = "XMLDOMNodeList" ENDIF ELSE lcGetType = loParts.elementType ENDIF IF loParts.parameterOrder = -1 &&check for return value lcRetType = lcGetType ELSE lcTips2Str = lcTips2Str + loParts.elementName + " AS " lcTips2Str = lcTips2Str + lcGetType IF loParts.IsInput = 1 &&byref call lcTips2Str = lcTips2Str + " @" ENDIF lcTips2Str = lcTips2Str + ", " ENDIF ENDDO lcTips2Str=ALLTRIM(lcTips2Str) IF RIGHT(lcTips2Str,1)="," lcTips2Str = SUBSTR(lcTips2Str,1,LEN(lcTips2Str)-1) ENDIF lcTipsStr = lcTipsStr + loMethod.Name + "(" + lcTips2Str + ")" lcTipsStr = lcTipsStr + " AS " + lcRetType + CRLF ENDDO &&SoapOperations (Methods) * Add Class record to WS table lcID = SYS(2015) ldDateTime = DATETIME() LOCATE FOR UPPER(ALLTRIM(Name))==UPPER(ALLTRIM(lcWSName)) AND UPPER(TYPE)="C" AND ; UPPER(ALLTRIM(URI))==UPPER(ALLTRIM(lcWSDL)) AND ; UPPER(ALLTRIM(Port))==UPPER(ALLTRIM(lcServicePort)) AND !DELETED() IF FOUND() IF tlRefresh REPLACE Name WITH lcWSName, ; Menu WITH lcMethodStr, ; Tips WITH lcTipsStr, ; URI WITH lcWSDL, ; WSML WITH lcWSMLGTM, ; Class WITH lcClass, ; Port WITH lcServicePort, ; Timestamp WITH ldDateTime, ; UniqueID WITH lcID,; Comfile WITH lcServiceDoc,; Prefs WITH lcMethodStr2 ENDIF ELSE INSERT INTO (THIS.cWSAlias) (Type, Name, Menu, Tips, URI, WSML, Class, Port, TimeStamp, UniqueID, Toolbox, Comfile, Prefs); VALUES("C", lcWSName, lcMethodStr, lcTipsStr, lcWSDL, lcWSMLGTM, lcClass, lcServicePort, ldDateTime, lcID, .T., lcServiceDoc, lcMethodStr2) ENDIF loEnumParts = 0 loParts = 0 loEnumMethods = 0 loMethod = 0 loPort = 0 ENDDO &&Ports loEnumPorts = 0 loService = 0 ENDDO &&Service * Write out preferences THIS.Updateprefs("MENU",lcWSName,.T.) SELECT (lnSaveArea) ENDPROC PROCEDURE vartypetostring LPARAMETERS nType DO CASE CASE ntype = 0 && VT_EMPTY RETURN "variant" CASE ntype = 1 && VT_NULL RETURN "NULL" CASE ntype = 2 && VT_I2 RETURN "integer" CASE nType = 3 && VT_I4 RETURN "integer" CASE nType = 4 && VT_R4 RETURN "number" CASE nType = 5 && VT_R8 RETURN "double" CASE nType = 6 && VT_CT RETURN "currency" CASE ntype = 7 RETURN "date" CASE ntype = 8 RETURN "string" CASE ntype = 9 && VT_DISPATCH RETURN "VARIANT" CASE nType = 11 RETURN "boolean" CASE nType = 12 && VT_VARIANT RETURN "variant" CASE nType = 16 && VT_I1 RETURN "number" CASE nType = 17 && VT_UI1 RETURN "number" CASE nType = 18 && VT_UI2 RETURN "number" CASE nType = 19 && VT_UI4 RETURN "number" CASE nType = 22 && VT_INT RETURN "integer" CASE nType = 23 && VT_UINT RETURN "integer" CASE nType = 24 && VT_VOID RETURN "VOID" CASE nType = 25 && VT_HRESULT RETURN "VOID" OTHERWISE RETURN "variant" ENDCASE ENDPROC PROCEDURE checkwsdbf * Add WS record to WS table LOCAL lcVFPWSDBF, lSafety, lnSaveArea, lcHomeFoxCode, lnFoxCodeVer lnFoxCodeVer=1 lnSaveArea = SELECT() IF !EMPTY(THIS.cWSAlias) AND SELECT(THIS.cWSAlias)#0 RETURN ENDIF lcVFPWSDBF = ADDBS(JUSTPATH(_FOXCODE)) + FOXWSDBF SELECT 0 IF FILE(lcVFPWSDBF) USE (lcVFPWSDBF) SHARED AGAIN IF THIS.lHadError OR EMPTY(ALIAS()) THIS.lHadError = .F. SELECT (lnSaveArea) RETURN .F. ENDIF * Check for valid format (allow for users to add extra fields IF FCOUNT() >= 15 THIS.cWSAlias = ALIAS() RETURN ENDIF USE ENDIF * First time or bad format lSafety = SET("Safety") SET SAFETY OFF CREATE TABLE (lcVFPWSDBF) (; TYPE c(1),; Name m,; Menu m,; Tips m,; URI m,; WSDL m,; WSML m,; Prefs m,; COMFile m,; ASPFile m,; Project m,; UsePHook l,; Toolbox l,; Class m,; Port m,; Timestamp t,; UniqueID c(10),; User m ) USE (lcVFPWSDBF) SHARED AGAIN SET SAFETY &lSafety IF EMPTY(ALIAS()) SELECT (lnSaveArea) RETURN .F. ENDIF THIS.cWSAlias = ALIAS() SELECT 0 lcHomeFoxCode =ADDBS(HOME(1))+"foxcode.dbf" IF !FILE(lcHomeFoxCode) lcHomeFoxCode = HOME()+"foxcode.dbf" ENDIF IF FILE(lcHomeFoxCode) USE (lcHomeFoxCode) AGAIN SHARED IF !EMPTY(ALIAS()) GO TOP lnFoxCodeVer = VAL(expanded) ENDIF USE ENDIF SELECT (THIS.cWSAlias) INSERT INTO (lcVFPWSDBF) (type,name) ; VALUES("V",TRANSFORM(lnFoxCodeVer)) ENDPROC PROCEDURE getvirdirs LOCAL oServObj, lcMachine, lcVirDir THIS.lignoreerrors=.T. oServObj= GetObject("IIS://localhost") THIS.lignoreerrors=.F. IF THIS.lhaderror THIS.lhaderror=.F. RETURN .F. ENDIF lcMachine = GETWORDNUM(SYS(0),1) lcVirDir="http://"+lcMachine+"/" DIMENSION THIS.aVirDirs[1,2] STORE "" TO THIS.aVirDirs THIS.LoopVirDirs(oServObj, lcVirDir, 1) IF THIS.lhaderror THIS.lhaderror=.F. RETURN .F. ENDIF ENDPROC PROCEDURE loopvirdirs LPARAMETERS oParent, tcVirDir, tnLevel LOCAL nLevel, cVirDir, oChild, loTmpParent, loTmpChild, lcPath, lAddVDir cVirDir = tcVirDir FOR EACH oChild IN oParent lAddVDir=.F. IF INLIST(UPPER(oChild.class),"IISWEBSERVICE","IISWEBSERVER", "IISWEBVIRTUALDIR", "IISWEBDIRECTORY") DO CASE CASE INLIST(UPPER(oChild.Name),"IISADMIN","IISHELP","PRINTERS","MSADC") LOOP CASE ATC("_vti_", oChild.Name)#0 LOOP CASE ATC(".",oChild.Name)#0 LOOP CASE oChild.AccessScript=.F. * LOOP CASE UPPER(oChild.class)="IISWEBVIRTUALDIR" * skip for certain common ones IF !UPPER(oChild.Name)=="ROOT" cVirDir = tcVirDir + oChild.name + "/" ENDIF lcPath = oChild.Path lAddVDir=.T. CASE UPPER(oChild.class)="IISWEBDIRECTORY" * VS uses web directories which are directories off of the parent. They do not * have a path so we need to traverse up to get paret on. lcPath = oChild.Name loTmpChild=oChild IF !UPPER(oChild.Name)=="ROOT" cVirDir = tcVirDir + oChild.name + "/" ENDIF DO WHILE .T. loTmpParent = GETOBJECT(loTmpChild.Parent) IF TYPE("loTmpParent.Path")="C" lcPath = ADDBS(loTmpParent.Path)+lcPath EXIT ELSE lcPath = loTmpParent.Name + "\" + lcPath ENDIF loTmpChild=loTmpParent ENDDO lAddVDir=.T. ENDCASE IF lAddVDir IF !EMPTY(THIS.aVirDirs) DIMENSION THIS.aVirDirs[ALEN(THIS.aVirDirs,1)+1,2] ENDIF THIS.aVirDirs[ALEN(THIS.aVirDirs,1),1] = cVirDir THIS.aVirDirs[ALEN(THIS.aVirDirs,1),2] = ADDBS(lcPath) ENDIF nLevel = tnLevel +1 THIS.LoopVirDirs(oChild, cVirDir, nLevel) ENDIF ENDFOR ENDPROC PROCEDURE updateprefs LPARAMETERS tcField, tcValue, tlAppend * Updates the Version record with default prefs LOCAL laItems, lnCount, i, lcTmpStr, lIsFile, lnSaveArea lnSaveArea=SELECT() IF EMPTY(tcField) OR EMPTY(tcValue) RETURN .F. ENDIF IF !THIS.CheckWSdbf() THIS.Alert(FILENOTOPEN_LOC + " ("+ ADDBS(JUSTPATH(_FOXCODE)) + FOXWSDBF + ")") RETURN .F. ENDIF SELECT (THIS.cWSAlias) LOCATE FOR UPPER(TYPE)="V" AND !DELETED() IF !FOUND() INSERT INTO (THIS.cWSAlias) (type,name,&tcField.) ; VALUES("V","1",tcValue) ELSE IF tlAppend DIMENSION laItems[1] lnCount = ALINES(laItems, &tcField.) lcTmpStr = ALLTRIM(tcValue) lIsFile = FILE(tcValue) FOR i = 1 TO lnCount IF EMPTY(laItems[m.i]) OR ; (lIsFile AND !FILE(laItems[m.i])) OR; UPPER(laItems[m.i]) == UPPER(tcValue) LOOP ENDIF lcTmpStr = lcTmpStr + CRLF + laItems[m.i] ENDFOR tcValue = lcTmpStr ENDIF REPLACE &tcField. WITH tcValue ENDIF SELECT (lnSaveArea) ENDPROC PROCEDURE genws LOCAL lcWSMLFile, lResult, lcListener * Generate WSDL/WSML files IF THIS.lGenWSDL DO CASE CASE !FILE(THIS.cCOMFile) THIS.Alert(NODLL_LOC) RETURN .F. CASE EMPTY(THIS.cWSDLFile) THIS.Alert(NOWSDL_LOC) RETURN .F. CASE EMPTY(THIS.cClass) THIS.Alert(NOCLASS_LOC) RETURN .F. CASE !THIS.lUseIsapi AND EMPTY(THIS.cASPListener) THIS.Alert(NOURL_LOC) RETURN .F. ENDCASE lcListener = IIF(THIS.lUseIsapi, THIS.cWSDLListener, THIS.cASPListener) lResult = THIS.GenWSDL() IF !lResult THIS.Alert(NOGENFILE_LOC+WSDLFILES_LOC) RETURN .F. ENDIF ENDIF * Generate ASP files IF !THIS.lUseIsapi AND THIS.lGenASP IF EMPTY(THIS.cASPFile) THIS.Alert(NOASP_LOC) RETURN .F. ENDIF IF EMPTY(THIS.cWSDLFile) THIS.Alert(NOWSDL_LOC) RETURN .F. ENDIF lcWSMLFile = FORCEEXT(THIS.cWSDLFile,"WSML") IF EMPTY(THIS.cAppName) THIS.Alert(NOAPPNAME_LOC) RETURN .F. ENDIF lResult = THIS.GenASP(THIS.cASPFile, THIS.cWSDLFile, lcWSMLFile, THIS.cAppName) IF !lResult THIS.Alert(NOGENFILE_LOC+ASPFILES_LOC) RETURN .F. ENDIF ENDIF * Register XML Web service - for use with IntelliSense too IF THIS.lGenIntellisense IF !THIS.AddFoxCode(THIS.cWSDLListener, .T.) THIS.lISenseFailed=.T. ENDIF ENDIF THIS.SavePrefs() ENDPROC PROCEDURE autows LPARAMETERS tcCOMFile, tcClass PRIVATE lcRetVal,lcRetVal2 LOCAL lRetval, lnPos, loConfig, lcName, lcDefPath, lcName2 LOCAL oTypelib, i, lnCount, laMethods, lcDefURI IF THIS.lPrefsLoaded RETURN ENDIF THIS.cClass = tcClass THIS.cCOMFile = tcCOMFile * Try to load prefs THIS.lPrefsExist = .F. IF THIS.LoadPrefs() THIS.lPrefsExist = .T. THIS.lPrefsLoaded = .T. ENDIF * Try to find project IF EMPTY(THIS.cProject) THIS.GetProject() ENDIF IF THIS.lPrefsLoaded RETURN ENDIF * Get methods DIMENSION laMethods[1] lnCount = 0 oTypelib = NEWOBJECT("_typelib", ADDBS(JUSTPATH(THIS.ClassLibrary))+"_utility.vcx") oTypelib.cTypelib = THIS.cCOMFile lnCount = oTypelib.GetMethods(@laMethods, THIS.cClass,.F. ,.F. ,.T.) IF lnCount > 0 DIMENSION THIS.aMethods[lnCount] FOR i = 1 TO lnCount THIS.aMethods[m.i] = laMethods[m.i,1] ENDFOR ENDIF * Get URI locations lcDefURI = THIS.cDeflocation lcDefPath="" IF EMPTY(lcDefURI) lRetval = THIS.GetPrefs("URI",@lcDefURI) IF !lRetval OR EMPTY(lcDefURI) OR ALLTRIM(lcDefURI)="*" * No default location selected, so prompt for one: lcRetval="" lcRetval2="" loConfig = NEWOBJECT("wsconfig",THIS.ClassLibrary,"","lcRetVal","lcRetVal2") loConfig.lDefaultMode = .F. loConfig.Show() lcDefURI = ALLTRIM(lcRetVal) lcDefPath = ALLTRIM(lcRetVal2) IF EMPTY(lcDefURI) RETURN .F. ENDIF * Need to recreate aVirDirs THIS.GetVirDirs() ELSE lcDefPath = ALLTRIM(GETWORDNUM(lcDefURI, 2, CHR(13))) lcDefURI = ALLTRIM(GETWORDNUM(lcDefURI, 1, CHR(13))) ENDIF ENDIF IF EMPTY(THIS.aVirDirs) THIS.GetVirDirs() ENDIF lnPos = ASCAN(THIS.aVirDirs,lcDefURI) IF lnPos = 0 * Check for Localhost in default URI IF ATC("http://localhost/",lcDefURI)#0 lnPos = ASCAN(THIS.aVirDirs, "http://" + ALLTRIM(GETWORDNUM(SYS(0),1)) + ; "/" + STREXTRACT(lcDefURI,"http://localhost/","",1,1)) ELSE * User specified a different location and path. ENDIF ENDIF * Determine name here lcName = JUSTSTEM(tcCOMFile) IF !EMPTY(THIS.cClass) * Specify default naming convention for filenames. You usually want to avoid * using long names since the naming convention is <> + "_" + <>. * This is essentially the same as the ProgID which is hidden in the WSML file for * security purposes. IF VARTYPE(THIS.lUseLongtName)="L" AND THIS.lUseLongtName lcName = JUSTSTEM(tcCOMFile)+"_"+THIS.cClass ELSE lcName = THIS.cClass ENDIF ENDIF THIS.lPrefsLoaded = .T. * Set defaults THIS.lGenWSDL = .T. THIS.lUseIsapi = .T. THIS.lGenASP = .T. THIS.lGenIntelliSense = .T. IF VAL(OS(3))=4 AND INLIST(VAL(OS(4)),10,90) THIS.lGenIntelliSense = .F. ENDIF lcName2 = CHRTRAN(lcName," ","_") &&avoid URL names with space, tabs THIS.cASPListener = lcDefURI + lcName2 + ".ASP" THIS.cWSDLListener = lcDefURI + lcName2 + ".WSDL" IF lnPos=0 *Could not find VDir on local machine so use specified one. THIS.cWSDLfile = ADDBS(lcDefPath) + lcName2 + ".WSDL" THIS.cASPfile = ADDBS(lcDefPath) + lcName2 + ".ASP" ELSE THIS.cWSDLfile = ADDBS(THIS.aVirDirs[lnPos+1]) + lcName2 + ".WSDL" THIS.cASPfile = ADDBS(THIS.aVirDirs[lnPos+1]) + lcName2 + ".ASP" ENDIF THIS.cAppName = lcName + APPNAME_SUFFIX THIS.lUseJScript = .F. THIS.cService = JUSTSTEM(THIS.cWSDLfile) * Limit to 24 chars (FOXCODE field) DO CASE CASE LEN(lcName) > 21 THIS.cISense = LEFT(lcName,24) CASE LEN(lcName) + LEN(WS_LOC) + 1 <= 24 THIS.cISense = lcName + " " + WS_LOC OTHERWISE THIS.cISense = lcName + "_WS" ENDCASE * Get Namespaces THIS.cURI1 = "http://tempuri.org/" + lcName + "/wsdl/" THIS.cURI2 = "http://tempuri.org/" + lcName + "/type/" THIS.cURI3 = "http://tempuri.org/" + lcName + "/message/" THIS.cURI4 = "http://tempuri.org/" + lcName + "/action/" RETURN ENDPROC PROCEDURE getprefs LPARAMETERS tcField, tcValue LOCAL lnSaveArea lnSaveArea = SELECT() * Gets a default pref IF EMPTY(tcField) RETURN .F. ENDIF IF !THIS.CheckWSdbf() THIS.lhaderror = .T. RETURN .F. ENDIF SELECT (THIS.cWSAlias) LOCATE FOR UPPER(TYPE)="V" IF !FOUND() SELECT (lnSaveArea) RETURN .F. ENDIF tcValue = ALLTRIM(&tcField.) SELECT (lnSaveArea) ENDPROC PROCEDURE saveprefs * Save project DLL prefs LOCAL lcPrefs, lnSaveArea, lcPrefs2, i, lcPrefs3, lcMethods lcPrefs2="" lnSaveArea=SELECT() IF !THIS.CheckWSdbf() THIS.Alert(FILENOTOPEN_LOC + " ("+ ADDBS(JUSTPATH(_FOXCODE)) + FOXWSDBF + ")") RETURN .F. ENDIF SELECT (THIS.cWSAlias) TEXT TO lcPrefs TEXTMERGE NOSHOW LPARAMETERS toWebS toWebS.cCOMFile = [<>] toWebS.cClass = [<>] toWebS.cProject = [<>] toWebS.cService = [<>] toWebS.lGenASP = <> toWebS.lGenWSDL = <> toWebS.lGenIntelliSense = <> toWebS.lUsePHook = <> toWebS.lUnicode = <> toWebS.lUseIsapi = <> toWebS.lUseJScript = <> toWebS.cASPListener = [<>] toWebS.cWSDLListener = [<>] toWebS.cASPfile = [<>] toWebS.cWSDLfile = [<>] toWebS.cAppName = [<>] toWebS.cISense = [<>] toWebS.cURI1 = [<>] toWebS.cURI2 = [<>] toWebS.cURI3 = [<>] toWebS.cURI4 = [<>] ENDTEXT IF !EMPTY(THIS.aMethods[1]) SET TEXTMERGE ON TO MEMVAR lcPrefs2 NOSHOW \DIMENSION toWebS.aMethods[<>] FOR i = 1 TO ALEN(THIS.amethods) \toWebS.aMethods[<>] = "<>" ENDFOR SET TEXTMERGE OFF SET TEXTMERGE TO lcPrefs = lcPrefs + CRLF + lcPrefs2 ENDIF SET TEXTMERGE ON TO MEMVAR lcMethods NOSHOW FOR i = 1 TO ALEN(THIS.aMethods) \<> \<> ENDFOR SET TEXTMERGE TO SET TEXTMERGE OFF *serviceName="<>" TEXT TO lcPrefs3 TEXTMERGE NOSHOW <> ENDTEXT LOCATE FOR UPPER(TYPE)="P" AND ; UPPER(ALLTRIM(COMfile))== UPPER(THIS.cCOMFile) AND ; UPPER(ALLTRIM(Class)) == UPPER(THIS.cClass) AND !DELETED() IF !FOUND() INSERT INTO (THIS.cWSAlias) (Type,Name,Menu,Prefs,Comfile,Class,Project,UsePHook,Timestamp,UniqueID) ; VALUES("P",THIS.cISense,lcPrefs3,lcPrefs,THIS.cCOMFile,THIS.cClass,THIS.cProject,THIS.lUsePHook,DATETIME(),SYS(2015)) ELSE REPLACE Prefs WITH lcPrefs,; Menu WITH lcPrefs3, ; Name WITH THIS.cISense, ; Project WITH THIS.cProject, ; UsePHook WITH THIS.lUsePHook, ; Timestamp WITH DATETIME(), ; UniqueID WITH SYS(2015) ENDIF SELECT (lnSaveArea) ENDPROC PROCEDURE loadprefs * Load project DLL prefs LOCAL lnSaveArea lnSaveArea = SELECT() IF !THIS.CheckWSdbf() THIS.Alert(FILENOTOPEN_LOC + " ("+ ADDBS(JUSTPATH(_FOXCODE)) + FOXWSDBF + ")") RETURN .F. ENDIF SELECT (THIS.cWSAlias) LOCATE FOR UPPER(TYPE)="P" AND ; UPPER(ALLTRIM(COMfile))== UPPER(THIS.cCOMFile) AND ; UPPER(ALLTRIM(Class)) == UPPER(THIS.cClass) AND !DELETED() IF !FOUND() OR EMPTY(ALLTRIM(prefs)) SELECT (lnSaveArea) RETURN .F. ENDI EXECSCRIPT(prefs,THIS) SELECT (lnSaveArea) ENDPROC PROCEDURE getproject * Checks to find if project for web service is opened. LOCAL laInts, lnCount, i, lcGuid, j, oTypelib DIMENSION laInts[1] lcGuid="" IF _VFP.Projects.Count = 0 RETURN ENDIF * Try to find and set project oTypelib = NEWOBJECT("_typelib", ADDBS(JUSTPATH(THIS.ClassLibrary))+"_utility.vcx") lnCount = oTypelib.Getclasses(@laInts,THIS.cComfile) FOR i = 1 TO lnCount IF laInts[m.i,1]==THIS.cClass lcGuid = laInts[m.i,2] EXIT ENDIF ENDFOR IF EMPTY(lcGuid) RETURN ENDIF FOR i = 1 TO _VFP.Projects.Count FOR j = 1 TO _VFP.Projects(m.i).Servers.Count IF _VFP.Projects(m.i).Servers(m.j).CLSID=lcGuid THIS.cProject = _VFP.Projects(m.i).Name EXIT ENDIF ENDFOR ENDFOR ENDPROC PROCEDURE getports LPARAMETERS tcWSDL * VFP7 Intellisense support for Web Service LOCAL lcServicePort,lcWSDL LOCAL oGen,loPort,loEnumPorts,loService,loEnumServices STORE 0 TO loPort,loEnumPorts,loService,loEnumServices THIS.lIgnoreErrors = .T. THIS.lHaderror = .F. DIMENSION THIS.aPorts[1] THIS.aPorts="" IF EMPTY(tcWSDL) RETURN .F. ENDIF lcWSDL = tcWSDL * Iterate thru all Services, Ports and Methods oGen = CREATEOBJECTEX(WSDLREADER_CLASS,"","") oGen.Load(lcWSDL,"") && should not assume that all web services have a WSML file. THIS.lIgnoreErrors = .F. IF THIS.lHadError THIS.lHadError = .F. RETURN .F. ENDIF * Get Services ogen.GetSoapServices(@loEnumServices) DO WHILE .T. loEnumServices.next(1,@loService,1) IF VARTYPE(loService)#"O" EXIT ENDIF THIS.cWSname=loService.Name * Get ports loEnumPorts=0 loService.GetSoapPorts(@loEnumPorts) DO WHILE .T. loEnumPorts.Next(1,@loPort,1) IF VARTYPE(loPort)#"O" EXIT ENDIF lcServicePort = loService.name+"."+loPort.name IF !EMPTY(THIS.aPorts[ALEN(THIS.aPorts)]) DIMENSION THIS.aPorts[ALEN(THIS.aPorts)+1] ENDIF THIS.aPorts[ALEN(THIS.aPorts)]= lcServicePort loPort = 0 ENDDO &&Ports loService = 0 ENDDO &&Services ENDPROC PROCEDURE getasp_vbs LPARAMETERS lcAppName, lcWSDL, lcWSML LOCAL lcTempStr,lcWSName lcWSName = PROPER(JUSTSTEM(lcWSDL)) * Begin textmerge here TEXT TO lcTempStr NOSHOW TEXTMERGE <%@ LANGUAGE=VBScript %> <% Option Explicit On Error Resume Next Response.ContentType = "text/xml" Dim SoapServer If Not Application("<>Initialized") Then Application.Lock If Not Application("<>Initialized") Then Dim WSDLFilePath Dim WSMLFilePath WSDLFilePath = Server.MapPath("<>") WSMLFilePath = Server.MapPath("<>") Set SoapServer = Server.CreateObject(SOAPSERVER_CLASS) If Err Then SendFault "Cannot create SoapServer object. " & Err.Description SoapServer.Init WSDLFilePath, WSMLFilePath If Err Then SendFault "SoapServer.Init failed. " & Err.Description Set Application("<>") = SoapServer Application("<>Initialized") = True End If Application.UnLock End If Set SoapServer = Application("<>") SoapServer.SoapInvoke Request, Response, "" If Err Then SendFault "SoapServer.SoapInvoke failed. " & Err.Description Sub SendFault(ByVal LogMessage) Dim Serializer On Error Resume Next ' "URI Query" logging must be enabled for AppendToLog to work Response.AppendToLog " SOAP ERROR: " & LogMessage Set Serializer = Server.CreateObject(SOAPSERIAL_CLASS) If Err Then Response.AppendToLog "Could not create SoapSerializer object. " & Err.Description Response.Status = "500 Internal Server Error" Else Serializer.Init Response If Err Then Response.AppendToLog "SoapSerializer.Init failed. " & Err.Description Response.Status = "500 Internal Server Error" Else Serializer.startEnvelope Serializer.startBody Serializer.startFault "Server", "The request could not be processed due to a problem in the server. Please contact the system admistrator. " & LogMessage Serializer.endFault Serializer.endBody Serializer.endEnvelope If Err Then Response.AppendToLog "SoapSerializer failed. " & Err.Description Response.Status = "500 Internal Server Error" End If End If End If Response.End End Sub %> ENDTEXT RETURN lcTempStr ENDPROC PROCEDURE getasp_js LPARAMETERS lcAppName, lcWSDL, lcWSML LOCAL lcTempStr * Begin textmerge here TEXT TO lcTempStr NOSHOW TEXTMERGE <%@ LANGUAGE=JScript %> <% Response.ContentType = "text/xml"; if( Application("<>") == void 0 ) { Application.Lock(); if( Application("<>") == void 0 ) { var SoapServer; var WSDLFilePath; var WSMLFilePath; WSDLFilePath = Server.MapPath("<>"); WSMLFilePath = Server.MapPath("<>"); try { SoapServer = Server.CreateObject(SOAPSERVER_CLASS); } catch(err) { SendFault("Cannot create SoapServer object. " + err.description + " (" + err.number + ")"); } try { SoapServer.Init(WSDLFilePath, WSMLFilePath); } catch(err) { SendFault("SoapServer.Init failed. " & err.description); } Application("<>") = SoapServer; } Application.UnLock(); } SoapServer = Application("<>"); try { SoapServer.SoapInvoke(Request, Response, ""); } catch(err) { SendFault("SoapServer.SoapInvoke failed. " & err.description); } function SendFault(LogMessage) { var Serializer; // "URI Query" logging must be enabled for AppendToLog to work Response.AppendToLog(" SOAP ERROR: " & LogMessage); try { Serializer = Server.CreateObject(SOAPSERIAL_CLASS); } catch(err) { Response.AppendToLog("Could not create SoapSerializer object. " & err.description); Response.Status = "500 Internal Server Error"; Response.End(); } try { Serializer.Init(Response); } catch(err) { Response.AppendToLog("SoapSerializer.Init failed. " & err.description); Response.Status = "500 Internal Server Error"; Response.End(); } try { Serializer.startEnvelope("", "", ""); Serializer.startBody(""); Serializer.startFault("Server", "The request could not be processed due to a problem in the server. Please contact the system admistrator. " + LogMessage, ""); Serializer.endFault(); Serializer.endBody(); Serializer.endEnvelope(); } catch(err) { Response.AppendToLog("SoapSerializer failed. " & err.description); Response.Status = "500 Internal Server Error"; Response.End(); } Response.End(); } %> ENDTEXT RETURN lcTempStr ENDPROC PROCEDURE checkvdirmap LPARAMETERS tcVirDir * Vdir = "IIS://LocalHost/w3svc/1/Root/" + name... LOCAL oVdirObj, oShell, lcFile, lnPos, loErr LOCAL laMaps DIMENSION laMaps[1] IF VARTYPE(tcVirDir)#"C" OR EMPTY(tcVirDir) RETURN ENDIF TRY oVDirObj = GetObject(tcVirDir) * Add SOAP Toolkit 3.0 ISAPI Extension mapping laMaps = oVdirObj.ScriptMaps oShell = CreateObject("WScript.Shell") lcFile = oShell.RegRead(ISAPIKEY) IF FILE(lcFile) AND VARTYPE(oVDirObj)="O" * Check if extension is there lnPos = ASCAN(laMaps,".wsdl",-1,-1,-1,5) * Add SOAP Toolkit 3.0 ISAPI Extension mapping if not already registered or has different one. DO CASE CASE lnPos=0 IF MESSAGEBOX(MB_UPDATEVDIR_LOC,36)=6 DIMENSION laMaps[ALEN(laMaps)+1] laMaps[ALEN(laMaps)] = ".wsdl," + lcFile + ",1,GET,POST" COMARRAY(oVdirObj,10) oVdirObj.Put("ScriptMaps", @laMaps) oVdirObj.SetInfo() ENDIF CASE ATC(lcFile, laMaps[lnPos])=0 IF MESSAGEBOX(MB_UPDATEVDIR2_LOC,36)=6 laMaps[lnPos] = ".wsdl," + lcFile + ",1,GET,POST" COMARRAY(oVdirObj,10) oVdirObj.Put("ScriptMaps", @laMaps) oVdirObj.SetInfo() ENDIF ENDCASE ENDIF CATCH TO loErr * Eat errors here since we do not need to detect for non-local vdirs. ENDTRY ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcErrorMsg THIS.lhaderror = .T. IF THIS.lIgnoreErrors OR INLIST(nError,1113,1426,2012) OR _VFP.StartMode>0 RETURN ENDIF TEXT TO lcErrorMsg NOSHOW TEXTMERGE <> ERR_LOCATION_LOC <> ERR_NUMBER_LOC <> ERR_METHOD_LOC <> ERR_MESSAGE_LOC <> ERR_LINE_LOC <> <> ERR_MSG1_LOC ERR_MSG2_LOC ENDTEXT IF MESSAGEBOX(lcErrorMsg,17,MB_ERRTITLE_LOC)#1 IF TYPE("THISFORM")="O" RELEASE THISFORM CANCEL ELSE RELEASE THIS ENDIF IF lUsingWizard CANCEL ENDIF RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF !EMPTY(THIS.cwsalias) AND SELECT(THIS.cwsalias)#0 SELECT (THIS.cwsalias) USE ENDIF THIS.aInts = null ENDPROC t ttv%Ui>s%jU5 Ta TCW%C U FB- F@-C fPCC fC f CC fC f C' %C4 CC 8 C@-C fPCC fC f CC fC f C' %C4 CC 4 FB-TC F'TCWSDLGEN.WSDLGenerator30N&TCmsxml2.domdocument.4.0NCCTCC T-%CCOMFILE a BULOGENLOGEN2LODOMLSUCCESS LNSAVEAREALCXMLTHIS CHECKWSDBFCWSALIASTYPECOMFILECCOMFILECLASSCCLASSMENU SAVEPREFSLOADXMLINIT GENERATEFILE UPDATEPREFSC %CC v)CInvalid parameter passed. B-%C0 9C)The WSDL or WSML file could not be found. B-%CTCWSML%C0 H9C)The WSDL or WSML file could not be found. B-%CuTCServer T T TC ]TC ]>TC C C 6TCSAFETYvG.CSET SAFETY &lcSafety. UTCASPTCWSDLTCWSML TCAPPNAME LCFILESTRLCWSDLLCWSML LCAPPNAMELCSAFETYLCASPTHISALERT LUSEJSCRIPT GETASP_JS GETASP_VBSR%C 4TKCxU TCMESSAGE STARTMODETHIS LSKIPALERTS CERRORMESSAGE b9TCC"IIS://LocalHost/w3svc/1/Root6TC\(TCIIsWebVirtualDir T -T aT -TaTT-T-CPathCT CTTC WScript.ShellNRT C>HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\MSSOAP\30\SOAPISAP\isapi%C 0^C/TC.wsdl,  ,1,GET,POSTC C ScriptMaps Cu Ta B U TCNEWVIRDIRTCPATHTCPARENTOSERVOBJVDIROBJ LHADERRORLCPARENTLAMAPSOSHELLLCFILECREATE ACCESSREAD ACCESSSCRIPT ACCESSEXECUTEASPBUFFERINGON APPISOLATEDASPALLOWSESSIONSTATECONTENTINDEXEDPUT APPCREATE2APPFRIENDLYNAMESETINFO SCRIPTMAPSREGREAD      ' !"#)J(J($%J(&'T()-(*T(* TCW%CEB- T%C|TCWSML&TCmsxml2.domdocument.4.0NT+-%C,T'--%CGenericCustomTypeMapper' T%C,T&-ACSelectionNamespaces xmlns:wsdl="/0". T"a)TCMSSOAP.WSDLReader30T(1a(-T(2-C,%(2 )!T(1-%(2dT(2-B-%C(3  FB- F(4C5 +a C6%CO! T T(78T (7T 9TC] TC>-CC8fCC f C:fW CC;fCCf C' %C4 %?>8 ;<&='>?DXr(4:8;<=>?W &' TC@ +aj C6%CO!T 8 T HV6 C .asmx?wsdlCCRfSOAP TCC>= CCRfSOAPPORTVTCC>= T T T!CA +a J(C6%CO!*%CUpdateSingleTable8 T8C C  T%" eT//wsdl:portType[@name=' ']/wsdl:operation[@name='8']/wsdl:documentationT CB% CTC DE )T!!8 C C CF TTGVOID +a TC6%CO!2%CHCloParts.SchemaNodebO F #%C:schemaI- T#DatasetB T#XMLDOMNodeList^ T#H%J TG# TK AS T#%L T @T, TC%CR,@ TCC>\"T8()%T AS GC C TC] TCQ-CC8fCC f C:fC CC;fCCf CCMfCC f C' %C4 % q>8 NO;=PM >?Q R!% r(4:8NO;=PM>?SQRC  a ! T T T T T T TCMENU a(T FUUTCWSDL TLREFRESHTCWSMLIJ LCMETHODSTR LCTIPSSTR LCTIPS2STR LCWSMLGTMLCWSNAME LCSERVICEPORT LCSERVICELCPORT LCSERVICEDOCLCWSDLLCWSMLLCID LDDATETIME LNSAVEAREALOXMLDOMLCCLASSOGENLOPARTS LOENUMPARTSLOMETHOD LOENUMMETHODSLOPORT LOENUMPORTS LOSERVICELOENUMSERVICESLCDOCSTR LCDOCXPATHLONODES LCMETHODSTR2 LFAILXPATH LCGETTYPELCURI CMETHODSTR LCWSDL_XML LCWSML_XMLTHIS LISENSEFAILEDAPORTSASYNCLOADXML SETPROPERTYDOCUMENTELEMENT NAMESPACEURI LIGNOREERRORS LHADERROR CHECKWSDBFCWSALIASGETSOAPSERVICESNEXTCWSNAMENAME DOCUMENTATIONTYPEURIWSDLWSML TIMESTAMPUNIQUEID GETSOAPPORTSGETSOAPOPERATIONS SELECTNODESLENGTHITEMTEXTGETOPERATIONPARTS LCRETTYPE ELEMENTTYPE SCHEMANODEPARAMETERORDER ELEMENTNAMEISINPUTPORTMENUTIPSCLASSCOMFILEPREFSTOOLBOX UPDATEPREFS H 5Bvariant S BNULL tBinteger Binteger Bnumber Bdouble Bcurrency  Bdate 5Bstring  VBVARIANT  wBboolean  Bvariant Bnumber Bnumber Bnumber Bnumber 9Binteger ZBinteger x BVOID  BVOID2BvariantUNTYPE T TCW#%C CW WB TCCM FOXWS3.DBFF%C0 Q%CC T- FB-%C.TCBQTCSafetyvG.h1C M M M M MMMMMMLLMMTC M QSET SAFETY &lSafety %CC FB-TCF"TCCQ foxcode.dbf%C0 xTCQ foxcode.dbf%C0 Q%CC #)TCgQ F%r VC_U LCVFPWSDBFLSAFETY LNSAVEAREA LCHOMEFOXCODE LNFOXCODEVERTHISCWSALIAS LHADERRORTYPENAMEMENUTIPSURIWSDLWSMLPREFSCOMFILEASPFILEPROJECTUSEPHOOKTOOLBOXCLASSPORT TIMESTAMPUNIQUEIDUSEREXPANDEDTaTCIIS://localhost\T-%oT-B-TCC]Thttp:///J(C%T-B-UOSERVOBJ LCMACHINELCVIRDIRTHIS LIGNOREERRORS LHADERRORAVIRDIRS LOOPVIRDIRS T T -X%CC f IISWEBSERVICE IISWEBSERVERIISWEBVIRTUALDIRIISWEBDIRECTORY H< CC fIISADMINIISHELPPRINTERSMSADC. C_vti_ . C. :.  -L& C fIISWEBVIRTUALDIR%C fROOT T /T T a% C fIISWEBDIRECTORYT T%C fROOT ;T / +aTC\$%CloTmpParent.PathbCTC !T \ T T a % s%C $"C$TC'TCCTCUOPARENTTCVIRDIRTNLEVELNLEVELCVIRDIROCHILD LOTMPPARENT LOTMPCHILDLCPATHLADDVDIRCLASSNAME ACCESSSCRIPTPATHPARENTTHISAVIRDIRS LOOPVIRDIRS TCW%CC UB-%C COThe XML Web Service data file could not be updated. Make sure it is not in use. (CCM FOXWS3.DBF) B- F -C fVC' %C4 wNINSERT INTO (THIS.cWSAlias) (type,name,&tcField.) VALUES("V","1",tcValue)  %x (lnCount = ALINES(laItems, &tcField.) TCTC0(gE%CC CC 0  CC fCf ?.$TC C C  T"REPLACE &tcField. WITH tcValue  FUTCFIELDTCVALUETLAPPENDLAITEMSLNCOUNTILCTMPSTRLISFILE LNSAVEAREATHIS CHECKWSDBFALERTCWSALIASTYPEp%6 H, C0 >C.You must first select a valid COM server file.B- CRCBYou must enter a WSDL file name for generation option(s) selected.B- C;3C#You must select a valid class name.B-  C UCEYou must enter an ASP listener URL for generation option(s) selected.B-$TC   6TC % 20CError generating WSDL files.B-%  %CRCBYou must enter an ASP file name for generation option(s) selected.B-%C/RCBYou must enter a WSDL file name for generation option(s) selected.B-TCWSML%CDC4Please specify an application name for ASP listener.B-'TC% /CError generating ASP files.B-%\%C a XTa CU LCWSMLFILELRESULT LCLISTENERTHISLGENWSDLCCOMFILEALERT CWSDLFILECCLASS LUSEISAPI CASPLISTENER CWSDLLISTENERGENWSDLLGENASPCASPFILECAPPNAMEGENASPLGENINTELLISENSE ADDFOXCODE LISENSEFAILED SAVEPREFS  5     %\BTTT-%CTaTa%C C%B   T 4T C_typelibCC _utility.vcxT T C --a %   ( "T C  T T%C9TCURI%% C C*  T T8TCwsconfiglcRetVal lcRetVal2T- CTCTC%CB- C5TCCC TCCC %C \ CTC %'%Chttp://localhost/TTC http://CCC]/Chttp://localhost/ TC%C "%C!L! sTC_TTaT"aT#aT$aT%a(%CCJgCCCJg Z T%-T C _T& .ASPT' .WSDL% T(C .WSDLT)C .ASP+T(CC .WSDL*T)CC .ASPT*ServerT+-T,C( H` C>T-C=( C>C web service>$T-  web service2T-_WS1T.http://tempuri.org//wsdl/1T/http://tempuri.org//type/4T0http://tempuri.org/ /message/3T1http://tempuri.org//action/BU2 TCCOMFILETCCLASSLCRETVAL LCRETVAL2LRETVALLNPOSLOCONFIGLCNAME LCDEFPATHLCNAME2OTYPELIBILNCOUNT LAMETHODSLCDEFURITHIS LPREFSLOADEDCCLASSCCOMFILE LPREFSEXIST LOADPREFSCPROJECT GETPROJECT CLASSLIBRARYCTYPELIB GETMETHODSAMETHODS CDEFLOCATIONGETPREFS LDEFAULTMODESHOW GETVIRDIRSAVIRDIRS LUSELONGTNAMELGENWSDL LUSEISAPILGENASPLGENINTELLISENSE CASPLISTENER CWSDLLISTENER CWSDLFILECASPFILECAPPNAME LUSEJSCRIPTCSERVICECISENSECURI1CURI2CURI3CURI4  TCW%C4B-%C _TaB- F-CfV %C4  FB- tcValue = ALLTRIM(&tcField.) FUTCFIELDTCVALUE LNSAVEAREATHIS CHECKWSDBF LHADERRORCWSALIASTYPE  T TCW%C COThe XML Web Service data file could not be updated. Make sure it is not in use. (CCM FOXWS3.DBF)B- F  M(`LPARAMETERS toWebS+%toWebS.cCOMFile = [<>]'!toWebS.cClass = [<>]+%toWebS.cProject = [<>]+%toWebS.cService = [<>]'!toWebS.lGenASP = <>)#toWebS.lGenWSDL = <>93toWebS.lGenIntelliSense = <>+%toWebS.lUsePHook = <>)#toWebS.lUnicode = <>+%toWebS.lUseIsapi = <>/)toWebS.lUseJScript = <>3-toWebS.cASPListener = [<>]5/toWebS.cWSDLListener = [<>]+%toWebS.cASPfile = [<>]-'toWebS.cWSDLfile = [<>]+%toWebS.cAppName = [<>])#toWebS.cISense = [<>]%toWebS.cURI1 = [<>]%toWebS.cURI2 = [<>]%toWebS.cURI3 = [<>]%toWebS.cURI4 = [<>]%CC  G`( 92DIMENSION toWebS.aMethods[<>](C \:3toWebS.aMethods[<>] = "<>"G`G`(TC C  G`( (C +QJ<> %<>G`(G` M(`*$ .(   <>!   @-C fPCC fC f CCfCf C' %C4  r   P CC]p U>CC] FULCPREFS LNSAVEAREALCPREFS2ILCPREFS3 LCMETHODSTHIS CHECKWSDBFALERTCWSALIASAMETHODSTYPECOMFILECCOMFILECLASSCCLASSNAMEMENUPREFSPROJECTUSEPHOOK TIMESTAMPUNIQUEIDCISENSECPROJECT LUSEPHOOKG TCW%C COThe XML Web Service data file could not be updated. Make sure it is not in use. (CCM FOXWS3.DBF)B- F@-CfPCCfCf CCfC f C' %C4 CC ' FB-C  FU LNSAVEAREATHIS CHECKWSDBFALERTCWSALIASTYPECOMFILECCOMFILECLASSCCLASSPREFS  T%COB4TC_typelibCC _utility.vcxTC  (%C  TC !%C B(C&(C C '%C C C TC C!ULAINTSLNCOUNTILCGUIDJOTYPELIBPROJECTSCOUNTTHIS CLASSLIBRARY GETCLASSESCCOMFILECCLASSSERVERSCLSIDCPROJECTNAMEp J(T aT - T %CB- T)TCMSSOAP.WSDLReader30C T -% T -B-C +aiC%COf!T TC +aXC%CO!T.%CCC  , C T C  T TUTCWSDL LCSERVICEPORTLCWSDLOGENLOPORT LOENUMPORTS LOSERVICELOENUMSERVICESTHIS LIGNOREERRORS LHADERRORAPORTSLOADGETSOAPSERVICESNEXTCWSNAMENAME GETSOAPPORTSI  TCCּ M(`<%@ LANGUAGE=VBScript %><%Option ExplicitOn Error Resume Next'!Response.ContentType = "text/xml"Dim SoapServer82If Not Application("<>Initialized") Then Application.Lock:4 If Not Application("<>Initialized") Then Dim WSDLFilePath Dim WSMLFilePath5/ WSDLFilePath = Server.MapPath("<>")5/ WSMLFilePath = Server.MapPath("<>")E? Set SoapServer = Server.CreateObject("MSSOAP.SoapServer30")UO If Err Then SendFault "Cannot create SoapServer object. " & Err.Description4. SoapServer.Init WSDLFilePath, WSMLFilePathLF If Err Then SendFault "SoapServer.Init failed. " & Err.Description71 Set Application("<>") = SoapServer71 Application("<>Initialized") = True End If Application.UnLock End If3-Set SoapServer = Application("<>")1+SoapServer.SoapInvoke Request, Response, ""NHIf Err Then SendFault "SoapServer.SoapInvoke failed. " & Err.Description%Sub SendFault(ByVal LogMessage) Dim Serializer On Error Resume NextE? ' "URI Query" logging must be enabled for AppendToLog to work93 Response.AppendToLog " SOAP ERROR: " & LogMessageGA Set Serializer = Server.CreateObject("MSSOAP.SoapSerializer30") If Err Then[U Response.AppendToLog "Could not create SoapSerializer object. " & Err.Description71 Response.Status = "500 Internal Server Error"  Else" Serializer.Init Response If Err ThenQK Response.AppendToLog "SoapSerializer.Init failed. " & Err.Description93 Response.Status = "500 Internal Server Error" Else$ Serializer.startEnvelope  Serializer.startBody Serializer.startFault "Server", "The request could not be processed due to a problem in the server. Please contact the system admistrator. " & LogMessage Serializer.endFault Serializer.endBody" Serializer.endEnvelope If Err ThenNH Response.AppendToLog "SoapSerializer failed. " & Err.Description;5 Response.Status = "500 Internal Server Error" End If End If End If Response.End End Sub%> BU LCAPPNAMELCWSDLLCWSML LCTEMPSTRLCWSNAME  M(`<%@ LANGUAGE=JScript %><%*$ Response.ContentType = "text/xml"; 4. if( Application("<>") == void 0 )  {  Application.Lock();60 if( Application("<>") == void 0 )  {   var SoapServer; var WSDLFilePath; var WSMLFilePath;  82 WSDLFilePath = Server.MapPath("<>");82 WSMLFilePath = Server.MapPath("<>");   try  {F@ SoapServer = Server.CreateObject("MSSOAP.SoapServer30");  } catch(err)  {ic SendFault("Cannot create SoapServer object. " + err.description + " (" + err.number + ")");  }   try  {:4 SoapServer.Init(WSDLFilePath, WSMLFilePath);  } catch(err)  {F@ SendFault("SoapServer.Init failed. " & err.description);  }  60 Application("<>") = SoapServer;   } Application.UnLock();   }2, SoapServer = Application("<>");  try  {71 SoapServer.SoapInvoke(Request, Response, "");  } catch(err)  {HB SendFault("SoapServer.SoapInvoke failed. " & err.description);  } & function SendFault(LogMessage)  {   var Serializer;  HB // "URI Query" logging must be enabled for AppendToLog to work  =7 Response.AppendToLog(" SOAP ERROR: " & LogMessage);   try  {HB Serializer = Server.CreateObject("MSSOAP.SoapSerializer30");  } catch(err)  { _Y Response.AppendToLog("Could not create SoapSerializer object. " & err.description);:4 Response.Status = "500 Internal Server Error"; Response.End();  }  try { & Serializer.Init(Response);  } catch(err)  {SM Response.AppendToLog("SoapSerializer.Init failed. " & err.description);:4 Response.Status = "500 Internal Server Error"; Response.End();  }  try { 1+ Serializer.startEnvelope("", "", "");% Serializer.startBody(""); Serializer.startFault("Server", "The request could not be processed due to a problem in the server. Please contact the system admistrator. " + LogMessage, "");" Serializer.endFault();! Serializer.endBody();% Serializer.endEnvelope();  } catch(err)  {NH Response.AppendToLog("SoapSerializer failed. " & err.description);:4 Response.Status = "500 Internal Server Error"; Response.End(); }   Response.End();   }  %> BU LCAPPNAMELCWSDLLCWSML LCTEMPSTR0 %CCC TBTC\TTC WScript.ShellNRTC>HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\MSSOAP\30\SOAPISAP\isapi%C0 CO (TC.wsdl HB %CٝThe Wizard has detected that your virtual directory is not setup to handle ISAPI listeners. Would you like to add a .WSDL application mapping to handle this?$xC/TC.wsdl, ,1,GET,POSTC C ScriptMaps C  CC%CThe Wizard has detected that your virtual directory has a .WSDL application mapping pointing to an ISAPI listener that is not the default SOAP 3.0 Toolkit one. Would you like to change this mapping to use the SOAP 3.0 Toolkit ISAPI listener?$x,T.wsdl, ,1,GET,POSTC C ScriptMaps C  ()U TCVIRDIROVDIROBJOSHELLLCFILELNPOSLOERRLAMAPS SCRIPTMAPSREGREADPUTSETINFOTa2%CY C ZB M(` <>Location: <>#Number: <>Method: <>Message: <> Line: <><>,&Press OK to ignore error and continue.Press Cancel to close.:%C XML Web Services Publisher Errorx%CTHISFORMbO< < %   B-U NERRORCMETHODNLINE LCERRORMSGTHIS LHADERROR LIGNOREERRORS STARTMODETHISFORM LUSINGWIZARDI#%C CW 4 FQTUTHISCWSALIASAINTSgenwsdl,genaspalert createvirdirv addfoxcode vartypetostring2 checkwsdbf getvirdirs loopvirdirsC" updateprefs&genws)autows/getprefs8 saveprefs : loadprefsuE getprojectGgetportsWI getasp_vbsL getasp_jsU checkvdirmapaErrorkfDestroyh1!qAqAAqaA31qAqAqAqAAaaRa3qA32!AAB3qqQQqAqAcQAAQAAqAAAAqA#qAqQAA1AAqQAAaAQqQAAAQQAqAAAqQAA#1AAARA1A1AAqA!QBA" AAA3qA3r2AAqAAAAASa0 qqA!AQAAAS3qAQaqA3AAA!bAQA1AqAAAA1!AAqABA3qA!qAqSAAAAA!A31q!!q!1qQqAAqAA!!qA!!qA!AqAqqAAAA2qAAA#AAAA1q!AAQqAAA"AbrBBA1%AAAAa1QAqAA1B3qqA!qAqA3!qAaqaqa1QaQQQQaArAaaAQAaaQaa!QaAWA2r!qAqA3bAACqqAAAAAaqAAAA3qqqAAqAqQAA1qQAAAAA3!QqAQQQQAqq1QaQq1q!QAQ !q!AA3raAaaaaaaa!q!aAaaA1aQ !QAQA3qsqAA!A AAAAAC2q!AA1a1aAqAqAAAqA31AA1"I,@eXG ah**j.C.T4su46 26<<@Z@E ETrTMVLmVbbbddggl-lu7ku{0"ԇCF)tPROCEDURE getproxycode * This routine assumes that we have Foxws3 table open and currently on a valid class record. * If you do not wish to use Foxws3 table, then call GenProxyCode directly, but ensure to first * set the code gen properties. * * Need to set Code Gen properties required by GenProxyCode. Note: the cGenWSML property is * only used with SOAP Toolkit XML Web services and only needed for custom type mapping LOCAL lSuccess, lcCLass TRY IF UPPER(Type)="C" lcClass = ALLTRIM(Class) * Need to validate class for variables IF CHRTRAN(lcClass ,"., ","___") # lcClass THIS.cGenVar = WSGEN_DEFAULTVAR ELSE THIS.cGenVar = "lo" + lcClass ENDIF THIS.cGenService = ALLTRIM(Name) THIS.cGenPort = ALLTRIM(Port) THIS.cGenWSDL = ALLTRIM(Uri) THIS.cGenWSML = ALLTRIM(wsml) IF !EMPTY(THIS.cGenWSML) THIS.lincludewsml = .T. ENDIF THIS.lAddFoxcodeHeader = .T. lSuccess=.T. ENDIF CATCH TO loException ENDTRY RETURN IIF(lSuccess,THIS.GenProxyCode(),"") ENDPROC PROCEDURE erroralert LPARAMETERS tcMessage MESSAGEBOX(tcMessage) ENDPROC PROCEDURE about *!* This class is the core class used for following: *!* - Handing of Proxy code generation for XML Web services ENDPROC PROCEDURE defaultsoapcode * This routine contains generated proxy code that calls SOAP 3.0 Toolkit APIs directly. * Do not call directly -- call from GenProxyCode! LOCAL lcStr,lcPosMarker lcStr="" lcPosMarker="~" IF THIS.lAddFoxCodeHeader lcStr = lcStr + [LOCAL ] + THIS.cGenVar + [ AS "] + ISENSETYPE + ["] + CRLF lcStr = lcStr + [* LOCAL ] + THIS.cGenVar + [ AS "] + SOAPCLIENT_CLASS + ["] + CRLF lcPosMarker="" ENDIF IF !THIS.lAddErrorCode TEXT TO lcStr TEXTMERGE NOSHOW ADDITIVE PRETEXT 2 * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service. *__VFPWSDef__: <> = <> , <> , <> LOCAL loException,lcErrorMsg <> = CREATEOBJECT(SOAPCLIENT_CLASS) <>.SOAPCLIENT_INIT(<>) * Call your XML Web service here. ex: leResult=<>.SomeMethod() <> ENDTEXT RETURN lcStr ENDIF TEXT TO lcStr TEXTMERGE NOSHOW ADDITIVE * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service. *__VFPWSDef__: <> = <> , <> , <> LOCAL loException,lcErrorMsg TRY <> = CREATEOBJECT(SOAPCLIENT_CLASS) <>.SOAPCLIENT_INIT(<>) * Call your XML Web service here. ex: leResult=<>.SomeMethod() <> CATCH TO loException lcErrorMsg="Error: "+TRANSFORM(loException.Errorno)+" - "+loException.Message DO CASE CASE VARTYPE(<>)#"O" * Handle SOAP error connecting to web service CASE !EMPTY(<>.FaultCode) lcErrorMsg=lcErrorMsg+CHR(13)+<>.Detail * Handle SOAP error calling method OTHERWISE * Handle other error ENDCASE * Use for debugging purposes MESSAGEBOX(lcErrorMsg) FINALLY ENDTRY ENDTEXT RETURN lcStr ENDPROC PROCEDURE defaultclasscode * This routine contains generated proxy code that calls SOAP 3.0 Toolkit APIs via a wrapper class. * Do not call directly -- call from GenProxyCode! * Get default wrapper class settings - from _ws3.h file. * Also, assumes class has a SetupClient method that sets up SOAP proxy. * #DEFINE DEFCLIENT_CLASS "WSClient" * #DEFINE DEFCLIENT_CLASSLIB "_ws3client.vcx" * #DEFINE DEFCLIENT_CLASSINIT "SetupClient" LOCAL lcProxyClass, lcProxyClasslib, lcProxyClassVar, lcProxyClassInit, lcStr, lcPosMarker lcProxyClass = IIF(EMPTY(THIS.cProxyClass), DEFCLIENT_CLASS, THIS.cProxyClass) lcProxyClasslib = IIF(EMPTY(THIS.cProxyClasslib), DEFCLIENT_CLASSLIB, "["+THIS.cProxyClasslib+"]") lcProxyClassInit = IIF(EMPTY(THIS.cProxyClassInit), DEFCLIENT_CLASSINIT, THIS.cProxyClassInit) lcProxyClassVar = IIF(EMPTY(THIS.cProxyVar), WSPROXYVAR, THIS.cProxyVar) lcStr="" lcPosMarker="~" IF THIS.lAddFoxCodeHeader lcStr = lcStr + [LOCAL ] + THIS.cGenVar + [ AS "] + ISENSETYPE + ["] + CRLF lcStr = lcStr + [* LOCAL ] + THIS.cGenVar + [ AS "] + SOAPCLIENT_CLASS + ["] + CRLF lcPosMarker="" ENDIF IF !THIS.lAddErrorCode TEXT TO lcStr TEXTMERGE NOSHOW ADDITIVE PRETEXT 2 * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service. *__VFPWSDef__: <> = <> , <> , <> LOCAL loException, lcErrorMsg, <> <> = NEWOBJECT("<>",<>) <> = <>.<>(<>) * Call your XML Web service here. ex: leResult=<>.SomeMethod() <> ENDTEXT RETURN lcStr ENDIF TEXT TO lcStr TEXTMERGE NOSHOW ADDITIVE * Do not remove or alter following line. It is used to support IntelliSense for your XML Web service. *__VFPWSDef__: <> = <> , <> , <> LOCAL loException, lcErrorMsg, <> TRY <> = NEWOBJECT("<>",<>) <> = <>.<>(<>) * Call your XML Web service here. ex: leResult = <>.SomeMethod() <> CATCH TO loException lcErrorMsg="Error: "+TRANSFORM(loException.Errorno)+" - "+loException.Message DO CASE CASE VARTYPE(<>)#"O" * Handle SOAP error connecting to web service CASE !EMPTY(<>.FaultCode) * Handle SOAP error calling method lcErrorMsg=lcErrorMsg+CHR(13)+<>.Detail OTHERWISE * Handle other error ENDCASE * Use for debugging purposes MESSAGEBOX(lcErrorMsg) FINALLY ENDTRY ENDTEXT RETURN lcStr ENDPROC PROCEDURE genproxycode * This routine is called to generate proxy code. It assumes that * necessary code gen properties are already set. If you are setting * code gen properties from FOXWS3 table, you should instead * call GetProxyCode instead, which calls this routine. * Ensures that other gen properties are of correct type. IF VARTYPE(THIS.cGenWSDL)#"C" OR EMPTY(THIS.cGenWSDL) RETURN "" ENDIF IF VARTYPE(THIS.cGenVar)#"C" OR EMPTY(ALLTRIM(THIS.cGenVar)) THIS.cGenVar = WSGEN_DEFAULTVAR THIS.lAddFoxcodeHeader = .T. ENDIF IF VARTYPE(THIS.cGenService)#"C" THIS.cGenService="" ENDIF IF VARTYPE(THIS.cGenPort)#"C" THIS.cGenPort="" ENDIF IF !THIS.lIncludeWSML OR VARTYPE(THIS.cGenWSML)#"C" OR ATC(".asmx?wsdl",THIS.cGenWSDL)#0 * Only include WSML file if SOAP Toolkit XML Web service using custom type mapper. * Skip for all VS XML Web services. THIS.cGenWSML ="" ENDIF DO CASE CASE EMPTY(THIS.cGenService) AND EMPTY(THIS.cGenPort) AND EMPTY(THIS.cGenWSML) THIS.cGenParms = ["] + THIS.cGenWSDL + ["] CASE EMPTY(THIS.cGenWSML) THIS.cGenParms = ["] + THIS.cGenWSDL + [", "] + THIS.cGenService + [", "] + THIS.cGenPort +["] OTHERWISE THIS.cGenParms = ["] + THIS.cGenWSDL + [", "] + THIS.cGenService + [", "] + THIS.cGenPort + [", "] + THIS.cGenWSML +["] ENDCASE * Now call routine to generate code RETURN IIF(THIS.lCustomClientCode, THIS.DefaultClassCode(), THIS.DefaultSoapCode()) ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcMessage THIS.lhaderror=.T. IF THIS.lSkiperror RETURN ENDIF lcMessage = MESSAGE() IF nError = 3 lcMessage = lcMessage + " " + FOXWSINUSE_LOC ENDIF THIS.ErrorAlert(lcMessage) ENDPROC